Kategorie szkoleń | Egzaminy | Kontakt
  • 2
  • 8
  • 244

Witajcie.

Chciałbym uaktualniać dane automatycznie. W Excelu w pliku Master.xlsx jedna z zakładek wymaga uaktualnień ze źródła, którym jest regularnie przychodzący mail o temacie Raport_xxx_by_yyy z załącznikiem xxx_by_yyy.xlsx.

Chciałbym zrobić to tak, by  makro uruchamiane w Excelu przyciskiem uaktualniało dane w zakładce xxx_by_yyy o dane z najnowszego maila z owym załącznikiem. Dane z załącznika nie muszą być nigdzie zapisane, wystarczyłoby je otworzyć (ActiveSheet.UsedRange.Copy???) i wkleić do pliku master.

Przeszukałem już Internet i znalazłem (tak mi się wydaje) rozwiązanie, które działa z Outlooka. Chciałbym jednak, by makro było uruchamiane z pliku Excela, z modułu w pliku Master.xlsm (plik będzie używany na innych komputerach, przez inne osoby, otrzymujące inne raporty xxx by yyy). To makro wydaje mi się najbardziej zrozumiałe i przejrzyste, jednak i tak na tę chwilę nieco chyba przerasta moje umiejętności.

Co należałoby zmienić, by działało nie z Outlooka tylko z Excela i dla źródła najnowszego w Inboxie załącznika xxx_by_yyy.xlsx? Rozumiem, że to makro musiałoby być uzupełnione o pętlę, która sprawdza kolekcję najnowszych maili w Inbox i wybiera najnowszy list z tematem Raport xxx by yyy.

Plik nie musi być zapisywany, wystarczy, że dane zostaną przekopiowane do Master.

Kandydata na rozwiązanie, przejrzysty przykład znalazłem tutaj:

http://www.mrexcel.com/forum/excel-questions/671290-visual-basic-applications-macro-save-csv-outlook-import-into-excel.html

Public  Sub  ExportFile(MyMail  As MailItem)
 Dim outNS  As Outlook.NameSpace
 Dim outFolder  As oulook.MAPIFolder
 Dim outNewMail  As Outlook.MailItem
 Dim strDir  As  String
     Set outNS  = GetNamespace( "MAPI")
     Set outFolder  = outNS.GetDefaultFolder(olFolderInbox)
     Set outNewMail  = outFolder.Items.GetLast
    strDir  =  "C:\"  'insert directory eg. "C:\Project\OutlookData\"
     If outNewMail.Attachments.Count  =  0  Then  GoTo Err
    outNewMail.Attachments( 1).SaveAsFile strDir  &  "Data.csv"
 Dim xlApp  As Excel.Application
 Dim xlWbk1  As Excel.Workbook
 Dim xlWbk2  As Excel.Workbook
     Set xlApp  =  New Excel.Application
    xlApp.DisplayAlerts  =  False
    
    xlApp.Workbooks.Open strDir  &  "Data.csv"
    xlApp.Workbooks.Open strDir  &  "Master.xlsb"
    
     Set xlWbk1  = xlApp.Workbooks( "Data.csv")
     Set xlWbk2  = xlApp.Workbooks( "Master.xlsb")
    
    xlWbk1.Sheets( 1).UsedRange.Copy Destination: =xlWbk2.Sheets( 1).Cells(Cells.SpecialCells(xlCellTypeLastCell).Row  +  1,  1)
    
    xlWbk2.Save
    xlApp.DisplayAlerts  =  True
    xlApp.Quit
    
     Set xlWbk2  =  Nothing
     Set xlWbk1  =  Nothing
     Set xlApp  =  Nothing
    
     Set outNewMail  =  Nothing
     Set outFolder  =  Nothing
     Set outNS  =  Nothing
Err:
     Set outFolder  =  Nothing
     Set OuNewMail  =  Nothing
     Set outNS  =  Nothing
    
 End  Sub

 

Z góry dziękuję za wszelkie propozycje i uwagi.

 

Jacek_Kotowski
  • Zapytał
  • @ Jacek_Kotowski | 29.09.2014
    • lider
    • laureat
    • ekspert
    • 60
    • 54
    • 94

Odpowiedzi (2)

  • 2

Witajcie.

Moje rozwiązanie na dziś wygląda jak niżej. Skorzystałem z rozwiązania opisanego tutaj:

http://www.ozgrid.com/forum/showthread.php?t=59353

Przerobiłem pod swoje potrzeby i chyba działa. Jeszcze testuję.

Czy można jakoś je ulepszyć? Zrobić bardziej uniwersalnym?

Na przykład, czy konieczne jest kopiowanie pliku, czy nie wystarczyłoby jego otwarcie z wiadomości Outlooka?

Z góry dziękuję za propozycje ulepszeń.

Sub SaveAttachments()
    Dim myOlapp As Outlook.Application
    Dim myNameSpace As Outlook.Namespace
    Dim myFolder As Outlook.MAPIFolder
    Dim myItem As Outlook.MailItem
    Dim myAttachment As Outlook.Attachment
    Dim I As Long
     
    Set myOlapp = CreateObject("Outlook.Application")
    Set myNameSpace = myOlapp.GetNamespace("MAPI")
    Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
    
'Ustaw podkatalog katalogu "Inbox" który będzie przeszukiwany.
    
    Set myFolder = myFolder.Folders("Raporty")
     
'Sprawdź, czy któryś z załączników ma szukaną nazwę, jeśli tak to skopiuj go do katalogu master'a
     
    For Each myItem In myFolder.Items
        If myItem.Attachments.Count <> 0 Then
            For Each myAttachment In myItem.Attachments
                I = I + 1
                
                If myAttachment.Filename = "aaa_by_bbb.xlsx" Then
                myAttachment.SaveAsFile ThisWorkbook.Path & "\" & "temp_aaa_by_bbb.xlsx"
                
                GoTo CopyingData

                End If
                
            Next
        End If
    Next
    
CopyingData:

'Otwórz tymczasowy plik załącznika
    Workbooks.Open ThisWorkbook.Path & "\" & "temp_aaa_by_bbb.xlsx"
    ThisWorkbook.Sheets(1).Range("A4:H100").Cells.Clear
    
'Skopiuj dane do master'a i zamknij
    ActiveWorkbook.Sheets(1).UsedRange.Copy
    ThisWorkbook.Sheets(1).Range("A4").PasteSpecial

    
'Zamknij i skasuj tymczasowy plik
    ActiveWorkbook.Close SaveChanges:=False
    Kill ThisWorkbook.Path & "\" & "temp_aaa_by_bbb.xlsx"

'Posprzątaj pamięć

    Set myOlapp = Nothing
    Set myNameSpace = Nothing
    Set myFolder = Nothing
    Set myFolder = Nothing
    
    
End Sub

 

 

 

Jacek_Kotowski
  • Odpowiedział
  • @ Jacek_Kotowski | 01.10.2014
    • lider
    • laureat
    • ekspert
    • 60
    • 54
    • 94
  • 0

Można chyba jeszcze zamknąć Outlooka:

myOlapp.Quit

Zamiast  GoTo CopyingData lepsze byłoby

Exit For 

No i wypadałoby dopisać obsługę błędów.

Poza tym nieźle.

  • Odpowiedział
  • @ | 14.09.2015
  • TRENER ALTKOM AKADEMII