Simpan email setiap hari dengan menyertakan jika nama file duplikat

Saya sedang menulis makro yang akan menyimpan email setiap hari. Saya baru saja memikirkan situasi yang mungkin bisa terjadi. Saya terkadang menerima email dengan subjek yang sama dari pengirimnya, namun setiap email memiliki konten yang berbeda. Saya ingin memiliki serangkaian pernyataan yang akan menangani hal ini. Mungkin dikatakan bahwa itu adalah salinan, atau bahkan mungkin menambahkan waktu juga pada nama file. Ini adalah kode yang saya miliki saat ini.

Public Sub SaveMsgs(Item As Outlook.MailItem)
 Dim sPath As String
 Dim dtDate As Date
 Dim sName As String
 Dim enviro As String
 Dim sSender As String
 Dim strFolder As String
 Dim strNewFolder As String
 Dim save_to_folder As String
 Dim strMyPath as String
 Dim intCount as Integer
 Dim 

 enviro = CStr(Environ("USERPROFILE"))

 sName = Item.Subject
 ReplaceCharsForFileName sName, "_"

 sSender = Item.Sender

 dtDate = Item.ReceivedTime
 sName = sSender & " - " & sName & ".msg"

 strNewFolder = Format(Date, "mm-dd-yyyy")
 strFolder = "C:\IT Documents\" & strNewFolder & "\"

 If Len(Dir(strFolder, vbDirectory)) = 0 Then
   MkDir (strFolder)
 End If

 save_to_folder = strFolder

 Item.SaveAs save_to_folder & sName, olMSG
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

Ini adalah kode yang ingin saya tambahkan.

Do While True 
  strMyPath = strFolder & sName 
  If objFSO>FileExists(strMyPath) Then 
    intCount = intCount + 1 
    sName = Copy (" & intCount & ") 
  Else Exit Do 
  End If 
Loop

Apakah hal seperti ini akan berhasil untuk apa yang saya coba lakukan, atau lebih baik menambahkan waktu ke nama file?


outlook vba
person novicevba    schedule 11.05.2015    source sumber
comment
Pada awalnya harap hapus Dim itu di akhir deklarasi Anda;).   -  person shA.t    schedule 12.05.2015

Jawaban (1)


arrow_upward
0
arrow_downward

Untuk menghemat dengan Tanggal Waktu Detik & Subjek yang bisa Anda lakukan

 sName = Format(dtDate, "MM-DD-YYYY", vbUseSystemDayOfWeek, _
                    vbUseSystem) & Format(dtDate, "-hhnnss", _
                    vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName & ".msg"
person 0m3r    schedule 12.05.2015
comment
Terima kasih untuk bantuannya. Tampaknya hal itu berhasil. Sekarang saya sedang mengerjakannya agar tidak muncul semua sebagai satu string tanpa ada tanda pemisah. Tapi saya bisa bermain-main dengan itu. Tapi masalah lain yang saya alami yang baru saya perhatikan, untuk beberapa alasan email tanggapan datang kembali dengan jenis file daripada .msg Misalnya, saya menerima email dari Joe, saya membalas, dan kemudian Joe membalas, tanggapan itu muncul sebagai jenis file file. Adakah ide mengapa ini terjadi? Saya telah membaca ulang kodenya dan sepertinya saya tidak dapat memahaminya sekarang. - person novicevba; 12.05.2015