Saya telah menjelajahi internet untuk mencari solusi untuk masalah ini, dan belum ada yang mengusulkan solusi. Inilah yang saya buat:
Masalah:
Akun Email Outlook Tipe IMAP tidak mengunduh Tubuh dan Lampirannya saat pertama kali tiba. Pakar Outlook di mana-mana akan memberi tahu Anda bahwa Anda dapat menyesuaikan ini di Pengaturan Lanjut Outlook, tetapi, mereka salah, itu tidak akan berpengaruh.
Solusi 1:
Beralih ke POP3. Dari sudut pandang pemrograman, ini menyelesaikan masalah, tetapi pendapat saya adalah bahwa jika Anda tidak dapat melakukannya dengan IMAP, maka Anda salah melakukannya, bukan?
Solusi 2:
Perhatikan bahwa ini adalah kekuatan kasar, tetapi itu menyelesaikan pekerjaan.
Di ThisOutlookSession:
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim objOutlook As Object
Dim objNameSpace As Object
Set objOutlook = Outlook.Application
Set objNameSpace = objOutlook.GetNamespace("MAPI")
'I am using this code on my gmail
Set Items = objNameSpace.Folders("mathern29@gmail.com").Folders("Inbox").Items
End Sub
Private Sub Items_ItemAdd(ByVal objItem As Object)
Dim objExcel As Object
Dim objMsg As Object
Dim Atmt As Outlook.Attachment
Dim Atmts As Outlook.Attachments
Dim objFSO As Object
Dim objFile As Object
Dim strFilePath As String
Dim strBody As String
On Error GoTo ErrorHandler
If TypeName(objItem) = "MailItem" Then
Set objMsg = objItem
If objMsg.DownloadState <> 1 Then
objMsg.Display
objMsg.Close (1)
Set objMsg = Nothing
DoEvents
Sleep (1000) 'Need a pause or the loop runs to fast and kills Outlook
RetryMailEvent objItem
Else
strBody = objMsg.Body
Set Atmts = objMsg.Attachments
For Each Atmt In Atmts
If Right$(Atmt.FileName, 3) = "txt" Then
Set objFSO = CreateObject("Scripting.FileSystemObject")
strFilePath = "C:\temp\" & Format(objItem.CreationTime, "yyyymmdd_hhnnss_") & Atmt.FileName
Atmt.SaveAsFile strFilePath
Set objFile = objFSO.OpenTextFile(strFilePath, 1)
strBody = strBody & "[Attatchment] " & objFile.ReadAll & " [/Attatchment]"
objFile.Close
Kill strFilePath
End If
Next Atmt
'Any additional Code you want to run goes here
End If
End If
ProgramExit:
Set objMsg = Nothing
Set objExcel = Nothing
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
Dalam modul terpisah:
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub RetryMailEvent(ByVal objItem As Object)
Dim objExcel As Object
Dim objMsg As Object
Dim Atmt As Outlook.Attachment
Dim Atmts As Outlook.Attachments
Dim objFSO As Object
Dim objFile As Object
Dim strFilePath As String
Dim strBody As String
On Error GoTo ErrorHandler
If TypeName(objItem) = "MailItem" Then
Set objMsg = objItem
If objMsg.DownloadState <> 1 Then
Set objMsg = Nothing
DoEvents
Sleep (1000) 'Need a pause or the loop runs to fast and kills Outlook
RetryMailEvent objItem
Else
strBody = objMsg.Body
Set Atmts = objMsg.Attachments
For Each Atmt In Atmts
If Right$(Atmt.FileName, 3) = "txt" Then
Set objFSO = CreateObject("Scripting.FileSystemObject")
strFilePath = "C:\temp\" & Format(objItem.CreationTime, "yyyymmdd_hhnnss_") & Atmt.FileName
Atmt.SaveAsFile strFilePath
Set objFile = objFSO.OpenTextFile(strFilePath, 1)
strBody = strBody & "[Attatchment] " & objFile.ReadAll & " [/Attatchment]"
objFile.Close
Kill strFilePath
End If
Next Atmt
'Any additional Code you want to run goes here
End If
End If
ProgramExit:
Set objMsg = Nothing
Set objExcel = Nothing
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
Catatan: Saya menjadi pengguna StackExchange hanya untuk berbagi temuan ini dengan Anda. Saya suka, silakan maju dan menghubungkan jiwa-jiwa bermasalah lainnya dengan masalah yang sama di sini :).