Attaching files from folder (1 Viewer)

eerkut

New member
Local time
Today, 03:59
Joined
Apr 24, 2012
Messages
6
Question one outlook has to be open to this code to work (how can be fixed)
Question two On the Public Sub AttachFile give error 424 qbject required.


Program runs on access 2000 but i was be able to make it run on access 2010 but because CDO is not included in office 2010 so I have to fix the code.

Thanks for any help.

Option Compare Database
Global Const gstrFileExt As String = "exp"
Sub SendEmailToHQ(strSubject As String)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.MailItem
Dim account As Outlook.account
Dim strExt As String

Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
objOutlookMsg.Subject = strSubject


With objOutlookMsg
.Body = "Weekly Upload"
Set objOutlookRecip = .Recipients.Add("*** Email address is removed for privacy ***")
objOutlookRecip.Type = olTo
objOutlookRecip.Resolve
Set objOutlookRecip = Nothing
'Set objOutlookAttach = objOutlookMsg.Attachment
strExt = "gstrFileExt"
AttachFile objOutlookMsg, "fixedexpenses", strExt
AttachFile objOutlookMsg, "unitperiod", strExt
AttachFile objOutlookMsg, "purchase", strExt
AttachFile objOutlookMsg, "purchasecharge", strExt
AttachFile objOutlookMsg, "payroll2", strExt
AttachFile objOutlookMsg, "registercloseout", strExt
AttachFile objOutlookMsg, "nonregistersales", strExt
AttachFile objOutlookMsg, "inventory", strExt
AttachFile objOutlookMsg, "expense", strExt
AttachFile objOutlookMsg, "cateringorder", strExt
AttachFile objOutlookMsg, "cateringorderitem", strExt
' objOutlookMsg.Update True, True
DelaySecs
.Send
'objOutlookMsg.Send showDialog:=False
DelaySecs
Set objOutlookMsg = Nothing
'oSess.Logoff
'Set oSess = Nothing
End With
End Sub
Private Sub DelaySecs()
Dim i As Integer
For i = 1 To 500
DoEvents
Next i
End Sub
Public Sub AttachFile(objOutlookMsg As Outlook.MailItem, strTable As String, strExt As String)
Set objOutlookAttach = objOutlookMsg.Attachments

If strRAPLoc = "" Then SetRapLoc
objOutlookAttach = strTable
objOutlookAttach.ReadFromFile strRAPLoc & "impexp\" & strTable & "." & strExt
'oAttach.Type = CdoFileData
objOutlookAttach.Position = 0
'oAttach.Fields.Add CdoPR_ATTACH_LONG_FILENAME, strTable
DelaySecs
Set objOutlookAttach = Nothing
End Sub
Public Sub DetachFile(objOutlookMsg As Outlook.MailItem, strTable As String, strExt As String)
Dim oAttach As Outlook.Attachment
Dim blnFound As Boolean
For Each oAttach In objOutlookMsg.Attachments()
If oAttach.name = strTable & "." & strExt Or oAttach.name = strTable Then
blnFound = True
Exit For
End If
Next
On Error Resume Next

If strRAPLoc = "" Then SetRapLoc

Kill strRAPLoc & "impexp\" & strTable & "." & strExt
On Error GoTo 0

If blnFound Then
oAttach.WriteToFile (strRAPLoc & "impexp\" & strTable & "." & strExt)
Set oAttach = Nothing
Else
If strTable = "Payroll" Then
DetachFile objOutlookMsg, "Payroll2", strExt
Else
Err.Raise "100", , "Attachment " & strTable & " not found"
End If
End If
End Sub
Public Function ProcessUpdateEmail() As String
On Error GoTo ErrFound
Dim oSess As New MAPI.Session
Dim oFold As MAPI.Folder
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookMsges As Outlook.MailItems
Dim oRecip As MAPI.Recipient
Dim strOut As String
Dim strResult As String
Dim strExt As String

oSess.Logon showDialog:=True

Set oFold = oSess.Inbox
Set objOutlookMsges = oFold.Messages
strResult = "No Email Found..."

strExt = gstrFileExt

For Each objOutlookMsg In objOutlookMsges
If Left(objOutlookMsg.Text, 11) = "Update Data" Then
DetachFile objOutlookMsg, "state", strExt
DetachFile objOutlookMsg, "county", strExt
DetachFile objOutlookMsg, "district", strExt
DetachFile objOutlookMsg, "calculationcode", strExt
DetachFile objOutlookMsg, "city", strExt
DetachFile objOutlookMsg, "unit", strExt
DetachFile objOutlookMsg, "gltypecode", strExt
DetachFile objOutlookMsg, "registertype", strExt
DetachFile objOutlookMsg, "expensetype", strExt
DetachFile objOutlookMsg, "vendor", strExt
DetachFile objOutlookMsg, "unitvendor", strExt
DetachFile objOutlookMsg, "unittype", strExt
DetachFile objOutlookMsg, "employee", strExt
DetachFile objOutlookMsg, "glaccount", strExt
DetachFile objOutlookMsg, "glsubaccount", strExt
DetachFile objOutlookMsg, "empunit", strExt
DetachFile objOutlookMsg, "unitglaccount", strExt
DetachFile objOutlookMsg, "inventorycategory", strExt
DetachFile objOutlookMsg, "register", strExt

strResult = ImportUpdateData
If strResult <> "" Then
strResult = "Error Importing. " & vbCrLf & strResult
GoTo ErrFound
End If
strResult = "Update Applied."
objOutlookMsg.Delete
Set objOutlookMsg = Nothing
End If
Next objOutlookMsg

MsgBox strResult

oSess.Logoff
Set oSess = Nothing
Exit Function
ErrFound:
strOut = strOut & Err.description & vbCrLf
MsgBox "Error." & vbCrLf & strResult, vbCritical, "Error Processing Updates"
End Function
 

spikepl

Eledittingent Beliped
Local time
Today, 08:59
Joined
Nov 3, 2010
Messages
6,144
Put

Option Explicit

at the top of you module. That should reveal you error. You should always have OPtion Explicit in all modules.
 

eerkut

New member
Local time
Today, 03:59
Joined
Apr 24, 2012
Messages
6
Thank you. I think, I need to go line by line and post the errors. This code was written access 2000 to work with outlook 2000. Dim oSess As New MAPI.Session gives compile error. how can i set session for outlook 2010? (p.s. I m not a programmer, so I really appreciate all the help)
 

eerkut

New member
Local time
Today, 03:59
Joined
Apr 24, 2012
Messages
6
I m trying to find help from diffrent forums. not the waste people times. you don't get good answers always from one forum. Sorry to waste your time.Thanks
 

Users who are viewing this thread

Top Bottom