2016-04-14 11 views
0

Genel klasörlerdeki eklerin dosya isimlerini ayıklamak ve kolay analiz için bunları excel dosyasına yapıştırmak istiyorum.Outlook Ekleri Gerekiyor Dosya adları (veya yalnızca uzantılar) Excel'e seçili e-postalar için dışa aktarılan numaralar

Aşağıdaki kodum var, ancak yalnızca 1 e-postanın ayrıntılarını seçiyor.

Nerede yanlış olduğunu anlamak isterim.

Option Explicit 
    Sub CopyToExcel() 
    Dim xlApp As Object 
    Dim xlWB As Object 
    Dim xlSheet As Object 
    Dim rCount As Long 
    Dim bXStarted As Boolean 
    Dim enviro As String 
    Dim strPath As String 

    Dim currentExplorer As Explorer 
    Dim Selection As Selection 
    Dim olItem As Outlook.MailItem 
    Dim myAttachments As Outlook.Attachments 
    Dim j As Long 
    Dim i As Integer 
    Dim Report As String 
    Dim attachment As attachment 
    Dim obj As Object 
    Dim strColB, strColC, strColD, strColE, strColF As String 

    ' Get Excel set up 
    enviro = CStr(Environ("USERPROFILE")) 
    'the path of the workbook 
    strPath = enviro & "\Documents\test.xlsx" 
     On Error Resume Next 
     Set xlApp = GetObject(, "Excel.Application") 
     If Err <> 0 Then 
      Application.StatusBar = "Please wait while Excel source is opened ... " 
      Set xlApp = CreateObject("Excel.Application") 
      bXStarted = True 
     End If 
     On Error GoTo 0 
     'Open the workbook to input the data 
     Set xlWB = xlApp.Workbooks.Open(strPath) 
     Set xlSheet = xlWB.Sheets("Sheet1") 
     ' Process the message record 

     On Error Resume Next 
    'Find the next empty line of the worksheet 
    rCount = xlSheet.Range("B" & xlSheet.Rows.Count).End(-4162).Row 


    ' get the values from outlook 
    Set currentExplorer = Application.ActiveExplorer 
    Set Selection = currentExplorer.Selection 
     For Each obj In Selection 

     Set olItem = obj 
     Set myAttachments = olItem.Attachments 

    'collect the fields 
    Next 


    For Each Selection In Selection 
     If Selection.Class = olMail Then 

    End If 

    For Each attachment In olItem.Attachments 
     Report = strColC & GetAttachmentInfo(attachment) 
     strColB = olItem.Attachments.Count 
     strColD = olItem.SenderEmailAddress 
     strColE = olItem.Categories 
     strColF = olItem.ReceivedTime 



    'write them in the excel sheet 

     xlSheet.Range("B" & rCount) = strColB 
     xlSheet.Range("c" & rCount) = Report 
     xlSheet.Range("d" & rCount) = strColD 
     xlSheet.Range("e" & rCount) = strColE 
     xlSheet.Range("f" & rCount) = strColF 

    'Next row 
     rCount = rCount + 1 
    Next 


    Next 

     xlWB.Close 1 
     If bXStarted Then 
      xlApp.Quit 
     End If 

     Set olItem = Nothing 
     Set obj = Nothing 
     Set currentExplorer = Nothing 
     Set xlApp = Nothing 
     Set xlWB = Nothing 
     Set xlSheet = Nothing 


    End Sub 

    Public Function GetAttachmentInfo(attachment As attachment) 
     On Error GoTo On_Error 
     Dim Report 
     Dim strColA, strColB, strColC, strColD, strColE, strColF As String 


     GetAttachmentInfo = "" 

     Report = strColA & "Display Name: " & attachment.DisplayName 
     Report = strColC & "File Name: " & attachment.filename 

     GetAttachmentInfo = Report 

     Exiting: 
      Exit Function 

     On_Error: 
     MsgBox "error=" & Err.Number & " " & Err.Description 
     Resume Exiting 

    End Function 
+0

(1) Eğer tutarlı bir şekilde girinti yaparsanız, makrolarınızı ayıklamak çok daha kolay olacaktır. (2) Bana göre, Eklentilerimin eklerini çıkaran döngü, Eklentileri ayarlayan döngü içinde değil. 'Her bir ek için olItem.Attachments' altındaki 'myAttachments = olItem.Attachments' değerini ayarlamanız gerekir. (3) Bu eklere erişmeden önce bir öğenin ekleri olup olmadığını kontrol etmiyorsunuz. OlItem.Attachments.Count = 0' ise bu kodun başarısız olmasını beklerim. –

+0

Merhaba Tony, sen muhteşem efendim !, Ben birçok hata ayıklama ve çözebilir biliyorum, sorun zaman eksikliği, ben operasyonlardan ve birçok operasyonel faaliyetleri yönetmek zorunda. Ben işleri daha kolay yapmaya çalışıyorum bu yüzden vba makrolarını deniyorum. Çok sabırlı olduğun ve soruları cevapladığın için teşekkür ederim. Yeniden başım belaya giriyor, değişiklikleri istediğim gibi yaptım, ancak e-postada 1'den fazla ek varsa, bu kodun 1'den fazla dosya alabilmesi için ekleri listesinde en fazla dosya olan 1 dosya adını aldım isim –

cevap

0

Şu an için Outlook'a erişimim yok, bu nedenle aşağıdaki makro çalıştırmayı denemek yerine okumaktan geçer. döndürülen bir değer istiyorsanız


Public Function GetAttachmentInfo(attachment As attachment) Sen sonunda As String gerekir. attachment'u hem anahtar kelime olarak hem de bir parametrenin adı olarak kullanıyorsunuz. Lütfen parametreyi yeniden adlandırın.

Report = strColA & "Display Name: " & attachment.DisplayName 
Report = strColC & "File Name: " & attachment.filename 

strColA ve strColA


bir Dim ifade ile bildirilebilir ancak şu değerlere verilen boş edilmemiştir. İkinci ifade, ilk olarak ayarlanan Report değerinin üzerine yazılır.


Art arda On Error kullanımınızın örneklerini görüyorum. Tamamen yararsız olduğunu anlayana kadar aynı şeyi yaptım. Geliştirme sırasında, tercümanın hatayı veren ifadede durmasını ve böylelikle neyin düzeltileceğini bilmenizi istersiniz. Teknik olmayan kullanıcılara verilen bir üretim makrosunda, daha kolay bir şeye ihtiyacınız var. Bu kodu silmenizi öneririm.


Neden ilk ekin adını aldığınızı göremiyorum, ancak diğer ekleri değil. Bu hataları düzeltmenizi ve gözden geçirilmiş kodunuzu yeniden yayınlamanızı öneririm.

İlgili konular