Hirdetés

  2. Fórumok
  3. Szoftverfejlesztés
  4. Programozás topic
  5. (kiemelt téma)

Hirdetés

100 000 érv a ReGalaxy mellett: Vásárolj Galaxy Z Fold7 I Z Flip7 vagy Galaxy S25 szériás készüléket, és régi mobilod felújítását 100 000 Ft-ig mi álljuk!

Új hozzászólás Aktív témák

  • #11916 total90 támogató
    Új Válasz #11916
    Új hozzászólás
    Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra
    Privát üzenet küldése

    total90

    támogató

    Jönnék megint valamivel :B

    Access VBA-ról van szó és a kód

    Option Compare Database
    Option Explicit

    Private Sub Email_senden()

    Dim olApp As New Outlook.Application
    Dim olNamespace As NameSpace
    Dim objMailItem As MailItem
    Dim objFolder As mapiFolder
    Dim strTo As String
    Dim strCC As String
    Dim strTitle As String
    Dim strSubject As String
    Dim strHTMLHeader As String
    Dim strMessage As String
    Dim strEmail As String
    Dim strFirstname As String
    Dim strLastname As String
    Dim strUsernumber As String
    Dim strDatabase As String
    Dim db As Database
    Dim rs As Recordset
    Dim strSQL As String
    Dim oItem As Outlook.MailItem
    Dim intAnzahl As Integer



    strDatabase = "C:\Users\user\Documents\Kontakte.accdb"
    Set db = CurrentDb


    Set olApp = CreateObject("Outlook.Application")
    Set olNamespace = olApp.GetNamespace("MAPI")
    Set objFolder = olNamespace.GetDefaultFolder(olFolderInbox)
    Set objMailItem = objFolder.Items.Add(olMailItem)


    strSQL = "Select * FROM Kontakte;"
    Set rs = db.OpenRecordset(strSQL)

    Do Until rs.EOF

    strEmail = ""
    strFirstname = ""
    strLastname = ""
    strUsernumber = ""

    If Not IsNull(rs!Email) = True Then strEmail = rs!Email
    If Not IsNull(rs!Firstname) = True Then strFirstnamee = rs!Firstname
    If Not IsNull(rs!Lastname) = True Then strLastname = rs!Lastname
    If Not IsNull(rs!Usernumber) = True Then strUsernumber = rs!Usernumber

    If strEmail = "" Then MsgBox "szöveg": rs.MoveNext: Exit Do
    If strFirstname = "" Then MsgBox "szöveg": rs.MoveNext: Exit Do
    If strLastname= "" Then MsgBox "szöveg": rs.MoveNext: Exit Do
    If strUsernumber = "" Then MsgBox "szöveg": rs.MoveNext: Exit Do

    strSubject = "Minden ok"
    strHTMLHeader = "<!DOCTYPE html><html><head><style>p {font: 11pt Calibri; text-align: left;}</style><style>td {border:1px solid; font: 11pt Calibri; text-align: center;}</style><style>th {border:1px solid; font: 11pt Calibri;}</style></head>"
    strTitle = "<p>Hallo</p>"
    strMessage = "<p>Easy :)</p>"
    'HTML Footer
    strMessage = strMessage & "</body></html>"

    With objMailItem
    If Not strEmail = "" Then .To = strEmail
    .Subject = strSubject
    .HTMLBody = strHTMLHeader & strTitle & strMessage
    .Display
    .Save
    End With




    rs.MoveNext
    Loop
    rs.Close

    Set rs = Nothing
    Set db = Nothing
    Set olApp = Nothing
    Set olNamespace = Nothing
    Set objFolder = Nothing
    Set objMailItem = Nothing

    End Sub

    Van egy tabellám, amiben meg vannak adva email, firstname, lastname és usernumber. Ha pl. kitörlök egy email címet, akkor jön egy megadott szöveg, hogy nincs az adatbázisban email és itt leáll.
    A problémám, hogy miért áll le, miért nem megy a következőre?

Új hozzászólás Aktív témák