A
AirgasRob
First thanks for all the help so far, I am a step closer to figuring out this
procedure.
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
procedure.
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