Leek: Vraag inzake VBA.. Wat doe ik hier fout?

[barendrecht82]

Option Compare Database

Private Sub Form_Current()

    DoCmd.SetWarnings False

    Dim Connectie As ADODB.Connection
    Dim rs_Query As ADODB.Recordset
    Dim Excel As Excel.Application
    Dim Workbook As Workbook
    Dim Mail As Outlook.Application
    Dim Mail_Item As Outlook.MailItem
    Dim t As Integer
    Dim Query_Name As String
    Dim Output_File_Name As String
    Dim Mail_To As String
    Dim Mail_CC As String
    Dim Mail_BCC As String
    Dim Mail_Subject As String
    Dim Mail_Body As String
    Dim Datum As String
        
    Datum = Format(Now, "d mmm yyyy")
        
'********************************************************************************************
'*                                                                                          *
'*  Vullen van variabelen                                                                   *
'*                                                                                          *
'********************************************************************************************
    
    Query_Name = "qry_stadswandeling"
    Output_File_Name = "C:\wandels.xls"
    Mail_To = Mail_To & "test@test.nl"
    Mail_Subject = "wandeling " & Datum
    Mail_Body = "This is an automatically generated E-mail message. Please do not reply"
        
'********************************************************************************************
'*                                                                                          *
'* Recordset opbouwen, Excel sheet vullen, .CSV file aanmaken en via E-mail versturen       *
'*                                                                                          *
'********************************************************************************************
                    
    Set Connectie = CurrentProject.Connection
    Set rs_Query = New ADODB.Recordset
    rs_Query.Open Query_Name, Connectie, adOpenKeyset, adLockOptimistic, adCmdTable
    If rs_Query.RecordCount = 0 Then
    
    Set Excel = New Excel.Application
    Excel.Visible = False
    Set Workbook = GetObject("C:\wandels - Blanco.xls")
    t = 8
    Workbook.Worksheets(1).Range("A2").Value = "Orders on Hold, " & Datum
    While rs_Query.EOF = False
            Workbook.Worksheets(1).Range("A" & t).Value = rs_Query!Account
            Workbook.Worksheets(1).Range("B" & t).Value = rs_Query!Debiteur
            Workbook.Worksheets(1).Range("C" & t).Value = rs_Query!Verkooporder
            Workbook.Worksheets(1).Range("D" & t).Value = rs_Query!cddeb
            Workbook.Worksheets(1).Range("E" & t).Value = rs_Query!ordersoort
            Workbook.Worksheets(1).Range("F" & t).Value = rs_Query!omschrijving
            Workbook.Worksheets(1).Range("G" & t).Value = rs_Query!orderbedrag
            Workbook.Worksheets(1).Range("H" & t).Value = rs_Query!cdstatus
            t = t + 1
            rs_Query.MoveNext
    Wend
        
    Kill Output_File_Name
    Workbook.SaveAs FileName:=Output_File_Name, FileFormat:=xlWorkbookNormal, CreateBackup:=False, Local:=True
    Workbook.Close SaveChanges:=False
    Excel.Quit
      
    Debug.Print Mail_Subject
    Set Mail = New Outlook.Application
    Set Mail_Item = Mail.CreateItem(olMailItem)
    With Mail_Item
        .To = Mail_To
        .CC = Mail_CC
        .BCC = Mail_BCC
        .Subject = Mail_Subject
        .Body = Mail_Body
        .Importance = olImportanceNormal
        .Attachments.Add Output_File_Name
        .Send
    End If
             
            
    rs_Query.Close                              'Afsluiten objecten
    Connectie.Close
    Set rs_Query = Nothing
    Set Connectie = Nothing
               
    DoCmd.Quit                                  'Afsluiten MS Access

End Sub

Ik ben namelijk bezig om een mail uit te sturen uit het systeem om die vervolgens in excel te krijgen. Alleen ik krijg nu elke keer Blok IF problemen...

Wat doe ik fout?

 

[huijb]

Visual Basic is iets anders dan Visual Basic for Applications, VBA is programmeren binnen Office applicaties. Verplaatst naar juiste sectie.

 

[HSV]

Er ontbreekt in ieder geval een 'End With'.

With Mail_Item
        .To = Mail_To
        .CC = Mail_CC
        .BCC = Mail_BCC
        .Subject = Mail_Subject
        .Body = Mail_Body
        .Importance = olImportanceNormal
        .Attachments.Add Output_File_Name
        .Send
 [COLOR=#FF0000]e[/COLOR][COLOR=#FF0000]nd[/COLOR][COLOR=#ff0000] with[/COLOR]
    End If