Visual Basic - Email versenden, wenn Bedingungen erfüllt sind

Hallo zusammen,

vielleicht könnt ihr mir weiterhelfen. Ich rätsel schon seit ein paar Tagen über eine Lösung. Ich möchte mit VB eine Email generieren, wenn ich 1. auf einen Button drücke und 2. bestimmte Bedingungen erfüllt sind.

Das erste ist erst einmal kein Problem. Eine Schleife habe ich auch integriert (kein großes Problem). Aber die Bedingungen, die erfüllt sein sollen (Wert in Spalte 16 < 90; Wert in Spalte 18 <> "ja"; Wert in Spalte 5 <> "QZ")

Folgendes habe ich schon einmal vorgearbeitet:

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long






Sub Email()

Dim Email As String, cc As String, Subj As String
Dim Msg As String, URL As String
Dim i As Integer, x As Double
Dim Zahl1 As String, Zahl2 As String, Zahl3 As String, Zahl4 As String, Zahl5 As String
For i = 362 To 371 'data in rows 362-371 -> ALS BEISPIEL

Zahl1 = Cells(i, 17)
Zahl2 = Cells(i, 18)
Zahl3 = Cells(i, 5)
Zahl4 = 90
Zahl5 = ""
Zahl6 = "ja"
Zahl7 = "QZ"


Select Case i
Case Zahl1 < Zahl4, Zahl1 <> Zahl5
Case Zahl2 = Zahl6
Case Zahl3 = Zahl7
End Select


' Get the email address
Email = Cells(i, 31)

' Message subject
Subj = "xxx!"

' Compose the message
Msg = ""
Msg = Msg & "xxx " & Cells(i, 32) & "," & vbCrLf & vbCrLf
Msg = Msg & "xxx " & Cells(i, 1) & " - xxx'" & Cells(i, 7) & "' zum " & Cells(i, 11) & " xxx." & vbCrLf & vbCrLf
Msg = Msg & "xxx." & vbCrLf & vbCrLf
Msg = Msg & "xxx." & vbCrLf & vbCrLf
Msg = Msg & "xxx!" & vbCrLf & vbCrLf
Msg = Msg & "xxx." & vbCrLf & vbCrLf
Msg = Msg & xxx." & vbCrLf & vbCrLf
Msg = Msg & "xxx" & vbCrLf
Msg = Msg & Cells(i, 33) & vbCrLf & vbCrLf
Msg = Msg & "xxx" & vbCrLf
Msg = Msg & "xxx" & Cells(i, 34) & vbCrLf
Msg = Msg & Cells(i, 35) & xxx" & vbCrLf & vbCrLf
Msg = Msg & "xxx" & vbCrLf
Msg = Msg & "xxx" & vbCrLf
Msg = Msg & "xxx" & vbCrLf
Msg = Msg & "xxx" & vbCrLf

' Replace spaces with %20 (hex)
Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")

' Replace carriage returns with %0D%0A (hex)
Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A") ' Create the URL
URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg

' Execute the URL (start the email client)
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus

' Wait two seconds before sending keystrokes
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%s"


Next i
End Sub


Ehrlich gesagt, komme ich nicht weiter und benötige Hilfe von einem Experten Das rot markierte ist der Problembereich. Mit ner if-Bedingung habe ich es auch nicht hinbekommen.

Wäre klasse, wenn mir jmd. weiterhelfen könnte

Greetz

 

Du verwendest eine Excel-Tabelle als Grundlage?

Die Select-Case-Abfrage geht so nicht.

Select Case i
Tab Case Zahl1 < Zahl4, Zahl1 <> Zahl5
Tab Tab Hier die Reaktion bei Übereinstimmung
Tab Case Zahl2 = Zahl6
Tab Tab Hier die Reaktion bei Übereinstimmung
Tab Case Zahl3 = Zahl7
Tab Tab Hier die Reaktion bei Übereinstimmung
Tab ( und eventuell: )
Tab Case Else
Tab Tab Hier die Reaktion bei Nichtübereinstimmun aller obigen Abfragen
End Select

Die Deklaration der Zahl1-7-Variablen als String ist fragwürdig.
Eventuell mal mit Variant testen.

Den Rest müssen die Kollegen klären.

 

Danke für die Antwort...Ja, ich nutze Excel

Ich habe die Lösung mit einer if-Bedingung gefunden. Es war mal wieder leichter als gedacht. Für alle, die sich dafür interessieren. Den rot markierten Bereich habe ich folgendermaßen geändert:

Dim Email As String, cc As String, Subj As String
Dim Msg As String, URL As String
Dim i As Integer, x As Double
Dim Zahl1 As Variant, Zahl2 As Variant, Zahl3 As Variant, Zahl4 As Variant, Zahl5 As Variant
For i = 10 To 20 'data in rows 10-20

Zahl1 = Cells(i, 16)
Zahl2 = Cells(i, 18)
Zahl3 = Cells(i, 5)
Zahl4 = 90
Zahl5 = ""
Zahl6 = "ja"
Zahl7 = "QZ"


If Zahl1 < Zahl4 And Zahl1 <> Zahl5 And Zahl2 <> Zahl6 And Zahl3 <> Zahl7 Then


Damit läufts...

 

Da würde ich mal ein paar Klammern setzen zur logischen Ordnung.
Ansonsten weiß man nach einer Woche nicht mehr, was man da für eine Müll programmiert hat ...

 

Die Deklaration der Variablen solltest du mal berichtigen.
Des weiteren kannst du dir die Deklaration von zahlX sparen.

Hier mal eine in 5 Minuten überarbeitete Version. Den Code könnte man sicher noch weiter optimieren und verkürzen, aber ich hab bei dem Wetter Heute keine Lust mir den Kopf darüber zu zerbrechen.

Als kleiner Denkanstoß:

PHP:

Sub email()

    'Variablen deklarieren
    Dim Email, cc, Subj, Msg, URL AS String
    Dim i AS Integer
    Dim x AS Double

    For i = 10 To 20
        'prüfen ob die Bedingungen erfüllt sind
        If Cells(i, 16) < 90 AND Cells(i, 16) <> "" AND Cells(i, 18) = "ja" AND Cells(i, 5) = "QZ" THEN

            ' Email Adresse und Subject in Variable übernehmen
            Email = Cells(i, 31)
            Subj = "xxx!"
    
            'Nachricht zusammensetzen
            Msg = ""
            Msg = Msg & "xxx " & Cells(i, 32) & "," & vbCrLf & vbCrLf & "xxx " & Cells(i, 1) & " - xxx'" & Cells(i, 7) & "' zum " & Cells(i, 11) & " xxx." & vbCrLf & vbCrLf
            Msg = Msg & "xxx." & vbCrLf & vbCrLf & "xxx." & vbCrLf & vbCrLf & "xxx!" & vbCrLf & vbCrLf & "xxx." & vbCrLf & vbCrLf & xxx." & vbCrLf & vbCrLf & "xxx" & vbCrLf
            Msg = Msg & Cells(i, 33) & vbCrLf & vbCrLf & "xxx" & vbCrLf & "xxx" & Cells(i, 34) & vbCrLf & Cells(i, 35) & xxx" & vbCrLf & vbCrLf
            Msg = Msg & "xxx" & vbCrLf & "xxx" & vbCrLf & "xxx" & vbCrLf & "xxx" & vbCrLf

            'Leerzeichen durch %20 und vbcrlf durch "%0D%0A" ersetzen
            Subj = Replace(Subj," ","%20")
            Msg = Replace(Replace(Msg, " ", "%20"), vbCrLf, "%0D%0A")

            'mailto URL erzeugen und Email Client aufrufen
            URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg
            ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus

            ' Wait two seconds before sending keystrokes
            Application.Wait (Now + TimeValue("0:00:02"))
            Application.SendKeys "%s"
        End If
    Next i
End Sub