G
Guest
But probably not!
First I have figured out the procedure, with lots of help from the web, to
export a query to Excel using an existing spreadsheet as my template.
Second I used sample code from Microsoft to create an outlook message from
access. On this I still can't get it to attach my excel file, created with
above procedure, from within VBA without me typing in the path manually. Need
help on that one.
I would like to put both codes together to have it run both parts
consecutively. Build excel file then email it. Figuring that out would be a
huge help! If I could get one more wish then it would as follows.
Part of the information being exported to excel contains the name of the
person I would like to email the file to. Can I capture that name and put it
on my send to?
Below are both procedures I am using.
Procedure1
Private Sub Command0_Click()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim strSQL As String
Dim strPath As String
Dim ExcelApp As Object
Dim wrkbuk As Object
Dim xl As Excel.Application
Dim xlbook As Excel.workbook
Dim xlsheet As Excel.worksheet
Set dbs = CurrentDb
On Error Resume Next
dbs.QueryDefs.Delete ("qryloc")
On Error GoTo 0
Set qdf = dbs.CreateQueryDef("qryloc")
Set rst = dbs.OpenRecordset("SELECT DISTINCT [loc] " & _
"FROM [TblMaintbl]")
With rst
Do While Not .EOF
strSQL = "SELECT loc, item FROM [TblMaintbl] WHERE [loc] = """ & _
![Loc] & """"
qdf.SQL = strSQL
strPath = "C:\TransferStation\ExportExcel\ " & _
![Loc] & ".xls"
On Error Resume Next
Kill strPath
On Error GoTo 0
DoCmd.TransferSpreadsheet _
TransferType:=acExport, _
TableName:="qryloc", _
FileName:=strPath
.MoveNext
Loop
.Close
End With
Set rst = Nothing
Set dbs = Nothing
End sub
Procedure2
Sub sendMessage(Optional AttachmentPath)
Dim olookApp As Outlook.Application
Dim olookMsg As Outlook.MailItem
Dim olookRecipient As Outlook.Recipient
Dim olookAttach As Outlook.Attachment
' create the Outlook session.
Set olookApp = CreateObject("Outlook.Application")
' create the message.
Set olookMsg = olookApp.CreateItem(olMailItem)
With olookMsg
' add the To recipient(s) to the message.
Set olookRecipient = .Recipients.Add("Somebody")
olookRecipient.Type = olTo
' set the Subject, Body, and Importance of the message.
.Subject = "This is an Automation test with Microsoft Outlook"
.Body = "Help me help you." & vbCrLf & vbCrLf
.Importance = olImportanceHigh 'High importance
' add attachments to the message.
If Not IsMissing(AttachmentPath) Then
Set olookAttach = .Attachments.Add(AttachmentPath)
End If
' resolve each Recipient's name
For Each olookRecipient In .Recipients
olookRecipient.Resolve
If Not olookRecipient.Resolve Then
olookMsg.Display ' display any names that can't be resolved
End If
Next
.Send
End With
Set olookMsg = Nothing
Set olookApp = Nothing
End Sub
First I have figured out the procedure, with lots of help from the web, to
export a query to Excel using an existing spreadsheet as my template.
Second I used sample code from Microsoft to create an outlook message from
access. On this I still can't get it to attach my excel file, created with
above procedure, from within VBA without me typing in the path manually. Need
help on that one.
I would like to put both codes together to have it run both parts
consecutively. Build excel file then email it. Figuring that out would be a
huge help! If I could get one more wish then it would as follows.
Part of the information being exported to excel contains the name of the
person I would like to email the file to. Can I capture that name and put it
on my send to?
Below are both procedures I am using.
Procedure1
Private Sub Command0_Click()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim strSQL As String
Dim strPath As String
Dim ExcelApp As Object
Dim wrkbuk As Object
Dim xl As Excel.Application
Dim xlbook As Excel.workbook
Dim xlsheet As Excel.worksheet
Set dbs = CurrentDb
On Error Resume Next
dbs.QueryDefs.Delete ("qryloc")
On Error GoTo 0
Set qdf = dbs.CreateQueryDef("qryloc")
Set rst = dbs.OpenRecordset("SELECT DISTINCT [loc] " & _
"FROM [TblMaintbl]")
With rst
Do While Not .EOF
strSQL = "SELECT loc, item FROM [TblMaintbl] WHERE [loc] = """ & _
![Loc] & """"
qdf.SQL = strSQL
strPath = "C:\TransferStation\ExportExcel\ " & _
![Loc] & ".xls"
On Error Resume Next
Kill strPath
On Error GoTo 0
DoCmd.TransferSpreadsheet _
TransferType:=acExport, _
TableName:="qryloc", _
FileName:=strPath
.MoveNext
Loop
.Close
End With
Set rst = Nothing
Set dbs = Nothing
End sub
Procedure2
Sub sendMessage(Optional AttachmentPath)
Dim olookApp As Outlook.Application
Dim olookMsg As Outlook.MailItem
Dim olookRecipient As Outlook.Recipient
Dim olookAttach As Outlook.Attachment
' create the Outlook session.
Set olookApp = CreateObject("Outlook.Application")
' create the message.
Set olookMsg = olookApp.CreateItem(olMailItem)
With olookMsg
' add the To recipient(s) to the message.
Set olookRecipient = .Recipients.Add("Somebody")
olookRecipient.Type = olTo
' set the Subject, Body, and Importance of the message.
.Subject = "This is an Automation test with Microsoft Outlook"
.Body = "Help me help you." & vbCrLf & vbCrLf
.Importance = olImportanceHigh 'High importance
' add attachments to the message.
If Not IsMissing(AttachmentPath) Then
Set olookAttach = .Attachments.Add(AttachmentPath)
End If
' resolve each Recipient's name
For Each olookRecipient In .Recipients
olookRecipient.Resolve
If Not olookRecipient.Resolve Then
olookMsg.Display ' display any names that can't be resolved
End If
Next
.Send
End With
Set olookMsg = Nothing
Set olookApp = Nothing
End Sub