olduğunda işe yaramıyor E-postalarımı şu anda kusursuz bir şekilde belirlenmiş bir klasöre arşivlemek için aşağıdaki kodu kullanıyorum .... E-posta konusunu içeren bir * ... bir hata ayıklama mesaj "çalışma zamanı hatası '-2147286788 (800300fc)'Outlook E-posta Arşivleme Makro Özeti yıldız işareti
Ben görmezden veya bu e-postaları otomatik olarak arşivlemek için izin başka bir şey * yerine yapmak için aşağıdaki koduna ekleyebilir şey var mı?
Option Explicit
Public Sub Received2016()
Dim oMail As Outlook.MailItem
Dim objItem As Object
Dim sPath As String
Dim dtDate As Date
Dim sName As String
Dim enviro As String
enviro = CStr(Environ("USERPROFILE"))
For Each objItem In ActiveExplorer.Selection
Set oMail = objItem
sName = oMail.Subject
ReplaceCharsForFileName sName, "_"
dtDate = oMail.ReceivedTime
sName = Format(dtDate, "yyyy-mm-dd - ", vbUseSystemDayOfWeek, _
vbUseSystem) & Format(dtDate, "hh-nn-ss", _
vbUseSystemDayOfWeek, vbUseSystem) & " - " & sName & ".msg"
sPath = "H:\Email Archive\2016 Emails\Received\"
Debug.Print sPath & sName
oMail.SaveAs sPath & sName, olMSG
Next
End Sub
Private Sub ReplaceCharsForFileName(sName As String, _
sChr As String _
)
sName = Replace(sName, "/", sChr)
sName = Replace(sName, "\", sChr)
sName = Replace(sName, ":", sChr)
sName = Replace(sName, "?", sChr)
sName = Replace(sName, Chr(34), sChr)
sName = Replace(sName, "<", sChr)
sName = Replace(sName, ">", sChr)
sName = Replace(sName, "|", sChr)
End Sub
Değiştir işlevinize * ekleyin. –