В Access VBA, как мне присоединить настроенный именованный файл к Outlook? - PullRequest
0 голосов
/ 01 октября 2018

Я пытаюсь переименовать свой отчет, чтобы он мог содержать название компании и дату его создания.Мой код не может прикрепить файл, потому что он не может найти файл.Кто-то пробовал это раньше или какие-либо предложения?

Private Sub emailReport_Click()
On Error GoTo ErrorHandler

Dim fileN As String
Dim todaysD As String
Dim oApp As Object
Dim oItem As Object
Const oMailItem As Long = 0
Set oApp = CreateObject("Outlook.Application")
Set oItem = oApp.CreateItem(oMailItem)


todaysD = Format(Date, "DD-MM-YYYY")

fileN = "Quantity used by " & CompanyName & " as of " & todaysD & ".pdf"
DoCmd.OutputTo acOutputReport, "reportQuantityUsed", acFormatPDF, fileN

With oItem
.To = ""
.CC = ""
.BCC = ""
.Subject = "Quantity used report - " & CompanyName
.Body = "Please find attached the quantity of stock used from: " & 
CompanyName
.Attachments.Add (fileN)
.Display
End With
exitErrorHandler:
Exit Sub
ErrorHandler: MsgBox Err.Description
GoTo exitErrorHandler

End Sub

1 Ответ

0 голосов
/ 02 октября 2018

Попробуйте условный код, чтобы открыть Outlook или использовать уже открытый экземпляр.Мои тесты показывают, что при открытии Outlook в Shell следующий код для установки и открытия объектов Outlook не будет работать сразу.Повторно запустите процедуру, оставив Outlook открытым, и код заработает.

Sub EMTest()
Dim oApp As Outlook.Application, OMail As Outlook.MailItem
On Error Resume Next
Set oApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
    Shell ("OUTLOOK")
    'allow enough time for app to completely open
    Dim Start As Double
    Start = Timer
    While Timer < Start + 10
        DoEvents
    Wend
    EMTest
End If
Set OMail = oApp.CreateItem(0)
With OMail
    .To = "email address"
    .Subject = "Subject"
    .Display 'email must be displayed for the next line to work to include default signature
    .HTMLBody = "Message." & vbNewLine & .HTMLBody
    '.Send
End With

Set OMail = Nothing
Set oApp = Nothing

End Sub
...