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?

 

[Elsendoorn2134]

Barendrecht82,

Ergens onderaan staat "With Mail_item"
Deze moet je afsluiten met End With anders krijg je bovenstaande problemen.

Veel Succes.

 

[barendrecht82]

Barendrecht82,

Ergens onderaan staat "With Mail_item"
Deze moet je afsluiten met End With anders krijg je bovenstaande problemen.

Veel Succes.

Thanks! Nu is het blok if verhaal opgelost. Alleen de mail wilt er niet uitgaan?

 

[Elsendoorn2134]

Barendrecht82,

De mail wordt alleen verstuurd als het recordcount is 0
If rs_Query.RecordCount = 0 Then

Volgens mij moet de mail worden verstuurd als er recordcount > 0.
Na het opvragen van een recordset is de recordcount meestal niet gevuld, hiervoor moet je eerst even
naar het einde springen rs_query.movelast (en natuurlijk weer terug rs_query.movefirst).
Beter kun je de volgende functie gebruiken om te kijken of er nog records zijn in de recordset.
if not rs_query.eof() then

Veel Succes.