Hi Arnelgp. I tried but now i get a new error.
"File not found"
Set oTxtStream = oFilesys.OpenTextFile(PATH & strReviewWorkOrdeMROR & ".HTML", 1)
i have no cluse whats going on
Option Compare Database
Private Sub send_Click()
Dim oFilesys, oTxtStream As Object
Dim txtHTML As String
Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Dim OutlookAttach As Outlook.Attachment
Dim strFileName As String
strt1_customs = "t1_customs"
Const PATH As String = "H:\t1customs"
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
DoCmd.OpenReport "t1_customs", acViewPreview, , "checklistID=" & Me.checklistID, acHidden
'
' agp
'
' you are missing a backslash on the folder name
' that is why it wasn't deleted
' when this sub exited
'
' create the PATH folder here first
If Dir(PATH, vbDirectory) = "" Then
MkDir PATH
End If
DoCmd.OutputTo acOutputReport, strt1_customs, acFormatHTML, PATH & strt1_customs & ".HTML", False
Set oFilesys = CreateObject("Scripting.FileSystemObject")
Set oTxtStream = oFilesys.OpenTextFile(PATH & strReviewWorkOrdeMROR & ".HTML", 1)
txtHTML = oTxtStream.ReadAll
oTxtStream.Close
Set oTxtStream = Nothing
Set oFilesys = Nothing
Dim db As DAO.Database
Dim rsParent As DAO.Recordset2
Dim rsChild As DAO.Recordset2
Set db = CurrentDb
Set rsParent = Me.Recordset
rsParent.OpenRecordset
Set rsChild = rsParent.Fields("shipattachment").Value
While Not rsChild.EOF
' we already check the folder above
' so i comment this out
'
' agp
'
''If Dir("H:\t1customs", vbDirectory) = "" Then
''MkDir ("H:\t1customs")
''Else
'''do nothing for the "C:\dbtemp" directory already exists
'''MsgBox "C:\dbtemp\ directory already exists"
''End If
''rsChild.OpenRecordset
'
' arnelgp
'
' save the original filename to variable
strFileName = rsChild.Fields("FileName")
rsChild.Fields("FileData").SaveToFile (PATH & strFileName)
rsChild.MoveNext
Wend
' dont forget to close what we opened
rsChild.Close
Set rsChild = Nothing
With MailOutLook
.bodyFormat = olFormatRichText
.To = "
bruce.zwarts@cevalogistics.com"
'.CC = " "
.Subject = "Expedition - T1 Inbound"
.HTMLBody = txtHTML
Dim fso As Object, SourceFolder As Object, SourceFile As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = fso.GetFolder(PATH)
For Each SourceFile In SourceFolder.Files
.Attachments.Add SourceFile.PATH '& "" & SourceFile.Name (SourceFolder.Path contains the path+filename)
Next
' display it here after processing all attachments
.Display
' dont forget to close fso
Set SourceFile = Nothing
Set SourceFolder = Nothing
Set fso = Nothing
'Send email
'.DeleteAfterSubmit = True 'This would let Outlook send the note without storing it in your sent bin
'.Send
Kill PATH & "*.*" ' delete all files in the folder
RmDir PATH '"H:\t1customs" ' delete folder
End With
'MsgBox MailOutLook.Body
'Kill " H:\t1customs" & strReviewWorkOrdeMROR & ".HTML"
'email_error:
'MsgBox "An error was encountered." & vbCrLf & "The error message is: " & Err.Description
'Resume Error_out
''Error_out:
End Sub