Access to Outlook Automation (Hopefully Easy Answer)


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
 
Ad

Advertisements

G

Guest

Fist off, I'd change the email sub to a function (you can then call it/use it
when ever you need)

*****
Function 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

Function Sub
*****

Then take your original command button code and make a slight mod

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
Call sendMessage(strPath)
..MoveNext
Loop
..Close
End With

Set rst = Nothing
Set dbs = Nothing

End sub


If you want to get fancy you could change it the function so it has an input
variable which will be used as the email recipient then when you call it you
could also pass that info.

Daniel














AirgasRob said:
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
 
Ad

Advertisements

G

Guest

Thank you very much for your help, I am a step closer to figuring out this
procedure.

I did post the wrong procedure I am using to create my excel application.
Below is the one I am using which is far simpler, to me. What I am not quite
sure how to do is pass the UDC_Buyer field to the function, and have it used
as the send to.


Procedure for exporting to excel

DoCmd.Hourglass True
Dim cnn1 As ADODB.Connection
Set cnn1 = CurrentProject.Connection
Dim myRecordSet As New ADODB.Recordset
myRecordSet.ActiveConnection = cnn1

Dim mySQL As String
mySQL = "SELECT Loc, Item, HoldComment, UDC_Buyer, PrevM01, PrevM02,
PrevM03, PrevM04, PrevM05, PrevM06, UDC_SkuCost FROM QryTblMaintbl WHERE
TblMaintbl.Loc = """ & [Forms]![FrmMain]![SelectLoc] & """"

myRecordSet.Open mySQL

Dim mysheetpath As String
mysheetpath = "C:\TransferStation\MarketIntelligence.xls"

Dim xl As Excel.Application
Dim xlbook As Excel.workbook
Dim xlsheet As Excel.worksheet

Set xl = CreateObject("excel.application")
Set xlbook = GetObject(mysheetpath)

xlbook.Windows(1).Visible = True

Set xlsheet = xlbook.worksheets(1)

xlsheet.range("a3").CopyFromRecordset myRecordSet

myRecordSet.Close

On Error Resume Next:

xlbook.SaveAs ("C:\TransferStation\ExportExcel\MarketIntelligence.xls")


xlsheet.Application.Quit

Set xl = Nothing
Set xlbook = Nothing
Set xlsheet = Nothing

DoCmd.SetWarnings False
DoCmd.OpenQuery "QryUpdateSent", acNormal, acEdit
DoCmd.SetWarnings True

DoCmd.Hourglass False

DoCmd.Close acForm, "FrmMain"

Call sendMessage("C:\TransferStation\ExportExcel\MarketIntelligence2.xls")

DoCmd.OpenForm "FrmMain", acNormal, "", "", , acNormal

Function for sending the outlook message

Function 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("Someone")
olookRecipient.Type = olTo
' set the Subject, Body, and Importance of the message.
.Subject = "This is an Automation test with Microsoft Outlook"
.Body = "I am so close to figuring this out." & 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
.Display

End With
Set olookMsg = Nothing
Set olookApp = Nothing

End Function
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top