Run Outlook rule

[rollingzep]

Hi,

Currently, I run a rule in Outlook which saves the MS Edge html files in the emails inbox folder to an attachments folder in the shared drive.
I then open an Access DB and click the Import button to import these files from the attachments folder.
The process works fine.

Is there a way to run the Outlook rule from the Access DB to download the Outlook files to the attachments folder
and then use the Import button to load the data into the table?

Also, I want to use a scheduler to run the above job on a specific time everyday at 8.15 am before everyone logs in, is that possible?

This is my Outlook code, which I run as a rule.

Sub NEW_AutoProcessXML(mymail As MailItem)



Dim MYNAMESPACE As NameSpace
Dim MYFOLDER As Outlook.Folder
Dim objAttachments As Outlook.Attachments

Set MYNAMESPACE = Outlook.GetNamespace("MAPI")
Set MYFOLDER = MYNAMESPACE.GetDefaultFolder(olFolderInbox)


Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
'Dim strDeletedFiles As String
Dim objSubject As String
Dim objDestfolder As Outlook.Folder


strFolderpath = "S:\beData\prof_data"
'On Error Resume Next

' Set the Attachment folder.
strFolderpath = strFolderpath & "\Attachments\"

'Set the Destination folder
Set objDestfolder = MYNAMESPACE.Folders.Item("WeeklyProceedings Mailbox").Folders.Item("Folders").Folders.Item("Archive_Proc")


objSubject = mymail.Subject

sreplace = "_"
'create an array to loop through and replace any potential illegal characters

For Each mychar In Array("/", "\", "^", "*", "%", "$", "#", "@", "~", "`", "{", "}", "[", "]", "|", ";", ":", ",", ".", "'", "+", "=", "?", "!", " ", Chr(34), "<", ">", "¦")
   objSubject = Replace(objSubject, mychar, sreplace)
Next mychar

    Set objAttachments = mymail.Attachments
    lngCount = objAttachments.Count
    'strDeletedFiles = ""

    If lngCount > 0 Then

        ' We need to use a count down loop for removing items
        ' from a collection. Otherwise, the loop counter gets
        ' confused and only every other item is removed.

        For i = lngCount To 1 Step -1

           strFile = objSubject & ".XML"

            ' Combine with the path to the Temp folder.
           strFile = strFolderpath & strFile

            ' Save the attachment as a file.
            objAttachments.Item(i).SaveAsFile strFile
       Next i

        
        mymail.Body = mymail.Body & vbCrLf & "The file was processed " & Now()
              
        mymail.Subject = "Processed - " & objSubject
        mymail.Save

    End If
  
    
    mymail.Move objDestfolder
'Next


Set objAttachments = Nothing
Set mymail = Nothing
End Sub

TIA

 

[rollingzep]

Unfortunately I am unable to post there since I get an error while posting

 

[welshgasman]

Out of ideas then, sorry.
One last one would be to examine objDestfolder in the locals window and ensure all the levels have values?