Automatyczny zapis załączników - nie działa skrypt VBA

Pytania, uwagi, problemy związane z Microsoft Office Outlook, wersje 2007, 2010, 2013 i 2016.

Moderator: Moderatorzy

Automatyczny zapis załączników - nie działa skrypt VBA

Postprzez blazejp » Śr 03.10.2018 08:56

Cześć,

Księgowa u mnie w firmie dostaje miesięcznie około 400 maili i w kazdym z nich jest faktura. Musi zapisywac ten plik na dysk u siebie lokalnie. Czy jest jakis sposób zeby zautomatyzować te zadanie?
Znalazłem skrypty VBA które mozna uzyc w outlooku na zapisywanie np. wszystkich załączników (co by było częściowym rozwiazaniem problemu), ale nawet to nie działa. Startuje regułe, ale zadne pliki nie pokazuja się w docelowej ścieżce
Poniżej wklejam przykładowe skrypty(w których sciezke zmieniam na np: "C:\temp") oraz prosiłbym o jakąś sugestkie jak ugryźć temat co do pobierania tylko tych zalaczników ktore chcemy(tylko faktur). Czy np jedyna metoda bylo by manulane wrzucanie tych maili do odpowiedniej zakładki w outlooku a pozniej uruchamianie reguły tylko na tym katalogu?

Kod: Zaznacz cały
Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String
sSaveFolder = "C:\Users\DT168\Documents\outlook-attachments\"
For Each oAttachment In MItem.Attachments
oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Next
End Sub


Kod: Zaznacz cały
Public Sub saveAttachtoDisk (itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String Dim dateFormat
    dateFormat = Format(itm.ReceivedTime, "yyyy-mm-dd H-mm")  saveFolder = "C:\Temp"
    For Each objAtt In itm.Attachments
        objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
    Next
End Sub
blazejp
 
Posty: 8
Dołączył(a): Wt 02.10.2018 14:14

Re: Automatyczny zapis załączników - nie działa skrypt VBA

Postprzez OShon » Śr 03.10.2018 12:14

Rozumiem że drugi kod jest twoją przeróbką i on właśnie nie działa.
Umieść w nowej linii lub dodaj dwukropek przed tą komendą
Kod: Zaznacz cały
saveFolder = "C:\Temp"

Też dim rozpoczynać powinno nową linię jako deklaracja, anie dopisany w ten sposób.
Kod: Zaznacz cały
Dim saveFolder As String Dim dateFormat

No i wypadało by spacje pomiędzy datą a nazwą załącznika.
Obrazek
Oskar Shon - MVP Office System/Development 11/19, 3x MCC
Forum moderator: Outlook.pl | ExcelForum.pl | MSDN dział VBA
Zobacz fajne dodatki: Outlooka, Excela, Worda lub PowerPointa
OShon
 
Posty: 9687
Dołączył(a): Cz 19.10.2006 08:31
Lokalizacja: Projekt autorski VBATools.pl

Re: Automatyczny zapis załączników - nie działa skrypt VBA

Postprzez blazejp » Śr 03.10.2018 12:29

Hmm.. no wlaśnie czy robię coś źle?
Zastosowałem się do twoich wskazówek. Skrypt wygląda tak jak poniżej, rula dodana i nadal folder docelowy pusty. Zmieniałem lokalizację na inną i testowałem na dwóch kompach.

Kod: Zaznacz cały
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    Dim dateFormat
    dateFormat = Format(itm.ReceivedTime, "yyyy-mm-dd H-mm")
    saveFolder = "C:\Temp"
    For Each objAtt In itm.Attachments
        objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
    Next
End Sub
blazejp
 
Posty: 8
Dołączył(a): Wt 02.10.2018 14:14

Re: Automatyczny zapis załączników - nie działa skrypt VBA

Postprzez OShon » Śr 03.10.2018 16:35

No do bobra, a podłączyłeś to do reguły, czy poprostu wkleiłeś i liczysz że coś się załapie?
Obrazek
Oskar Shon - MVP Office System/Development 11/19, 3x MCC
Forum moderator: Outlook.pl | ExcelForum.pl | MSDN dział VBA
Zobacz fajne dodatki: Outlooka, Excela, Worda lub PowerPointa
OShon
 
Posty: 9687
Dołączył(a): Cz 19.10.2006 08:31
Lokalizacja: Projekt autorski VBATools.pl

Re: Automatyczny zapis załączników - nie działa skrypt VBA

Postprzez blazejp » Cz 04.10.2018 13:35

No tak, stworzyłem nowa rule i zaznaczyłem 'run a script' i wybrałem ten skrypt z postu wyżej
blazejp
 
Posty: 8
Dołączył(a): Wt 02.10.2018 14:14

Re: Automatyczny zapis załączników - nie działa skrypt VBA

Postprzez OShon » Cz 04.10.2018 16:44

U mnie działa.

Może nie masz katalogu Temp..., a może nie działają ci reguły, lub jeszcze coś masz w regule co dyskwalifikuje ich realizację, lub wcześniej jest reguła która kończy dalsze działanie (kolejność reguł ma znaczenie).
Wywołać swoją procedure inną po zaznaczeniu kilku maili w folderze, które zawierają załączniki.
Kod: Zaznacz cały
Sub Wywolaj()
Dim item As MailItem
For Each item In Application.ActiveExplorer.Selection
    Call saveAttachtoDisk(item)
Next
End Sub
Obrazek
Oskar Shon - MVP Office System/Development 11/19, 3x MCC
Forum moderator: Outlook.pl | ExcelForum.pl | MSDN dział VBA
Zobacz fajne dodatki: Outlooka, Excela, Worda lub PowerPointa
OShon
 
Posty: 9687
Dołączył(a): Cz 19.10.2006 08:31
Lokalizacja: Projekt autorski VBATools.pl

Re: Automatyczny zapis załączników - nie działa skrypt VBA

Postprzez blazejp » Pt 05.10.2018 20:38

Ależ popełniłem rookie błąd! Nie sprawdziłem tego czy działa na innym kompie. Sprawdzałem na swoim roboczym lapku z win7, a w domu jak odpaliłem na win10 to poszło bez problemu. Nie wiem jeszcze czemu tam nie działa, ale wazne ze udało się to zrobić :)

Jeszcze mam małą prośbe - ogólnie te pliki które będą pobierane to są faktury. Niestety nie zawsze nazwa pliku to imie+nazwisko. Czy dał byś rade dodać do skryptu(mój post nr2), żeby nazwa pliku zawierała jeszcze pierwszy człon z adresu email(czyli to co jest przed znakiem '@')?

//edit

Prośba nr. 2 :) Czy mogłbyś też mi pomóc i dodać do kodu warunek w stylu: "jeśli plik nazywa się xyz.png to ignoruj i nie zapisuj załącznika w folderze" (najlepiej dwa takie przykłady plików [w sensie xyz.png i xyz2.jpg] w kodzie, żebym wiedział jak dodawać samemu kolejne nazwy plików:) )
Zamysł jest taki, że grafiki/emotikony i inne grafiki ze stopki są traktowane jako załączniki, a chciałbym mieć możliwość dodać kilka powtarzających się nazw tych plików tak żeby się one nie pobierały

Z góry dzięki
blazejp
 
Posty: 8
Dołączył(a): Wt 02.10.2018 14:14

Re: Automatyczny zapis załączników - nie działa skrypt VBA

Postprzez OShon » Pt 05.10.2018 21:43

#1 taka składnia np:

Kod: Zaznacz cały
saveFolder & "\" & dateFormat & " " & objAtt.DisplayName & _
            " " & Split(itm.SenderEmailAddress, "@")(0)

#2 ale co ty chcesz pliki wymieniać których nie chcesz, z nazwy?
Szaleństwo bo nie znasz jakie pliki możesz otrzymać (np w treści wiadomości)
Aby ograniczyć polecałbym raczej ukierunkować się na to co chcesz dostać, niż to co możesz.
Np pliki PDF, ponieważ je możesz otrzymać jako faktury. Pliki graficzne raczej fakturami nie są.
Obrazek
Oskar Shon - MVP Office System/Development 11/19, 3x MCC
Forum moderator: Outlook.pl | ExcelForum.pl | MSDN dział VBA
Zobacz fajne dodatki: Outlooka, Excela, Worda lub PowerPointa
OShon
 
Posty: 9687
Dołączył(a): Cz 19.10.2006 08:31
Lokalizacja: Projekt autorski VBATools.pl

Re: Automatyczny zapis załączników - nie działa skrypt VBA

Postprzez blazejp » So 06.10.2018 15:40

No i masz w sumie racje. Rzeczywiście tak powinno być prościej

Pomógł byś mi z kodem? Mniej więcej rozumiem, że powinno być to coś w rodzaju
-sprawdź jakie rozszerzenie ma plik
-jeśli ma pdf to zapisz
-jeśli ma inne niz pdf to ignoruj
blazejp
 
Posty: 8
Dołączył(a): Wt 02.10.2018 14:14

Re: Automatyczny zapis załączników - nie działa skrypt VBA

Postprzez OShon » So 06.10.2018 19:11

A co za to będę miał? Mam nadzieje ze przynajmniej stałego bywalca forum :D
W pętli wstaw taką linię zamiast swojej
Kod: Zaznacz cały
If UCase(Mid(objAtt.FileName, InStrRev(objAtt.FileName, "."))) = ".JPG" Then
        objAtt.SaveAsFile saveFolder & "\" & dateFormat & " " & objAtt.FileName & _
            " " & Split(itm.SenderEmailAddress, "@")(0)
       End If
Obrazek
Oskar Shon - MVP Office System/Development 11/19, 3x MCC
Forum moderator: Outlook.pl | ExcelForum.pl | MSDN dział VBA
Zobacz fajne dodatki: Outlooka, Excela, Worda lub PowerPointa
OShon
 
Posty: 9687
Dołączył(a): Cz 19.10.2006 08:31
Lokalizacja: Projekt autorski VBATools.pl

Re: Automatyczny zapis załączników - nie działa skrypt VBA

Postprzez blazejp » Pn 08.10.2018 08:44

Heh, wiadomo że zostane. To nie forum elektroda gdzie każdy ucieka(mam nadzieje) :D

Co do kodu to kurde.. niby prosta sprawa, ale nie dziala mi skrypt po umieszczeniu tych twoich poprawek. Pewnie źle to wkleiłem. Zerknął byś?

W pętli for wstawilem if. Chyba cos źle zrobiłem?;p Bo pobierają sie wszystkie
BTW - tam w twoim kodzie z ostatniego postu zmieniłem .JPG na .PDF , ale tez ciagle sie wszystkie pobierają.
Jak bys mógl te modyfikacje z nazwą i z pobieraniem plikow złączyc w jedno to już chyba nie męczył bym Cie więcej:P

Aaa i jeszcze nie wiem jak te modyfikacje wstawic z nazwą pliku. Tez cos mi nie wychodzi:<

Kod: Zaznacz cały
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    Dim dateFormat
    dateFormat = Format(itm.ReceivedTime, "yyyy-mm-dd H-mm")
    saveFolder = "C:\Temp"
    For Each objAtt In itm.Attachments
       If UCase(Mid(objAtt.FileName, InStrRev(objAtt.FileName, "."))) = ".JPG" Then
        objAtt.SaveAsFile saveFolder & "\" & dateFormat & " " & objAtt.FileName & _
            " " & Split(itm.SenderEmailAddress, "@")(0)
       End If
    Next
End Sub
blazejp
 
Posty: 8
Dołączył(a): Wt 02.10.2018 14:14

Re: Automatyczny zapis załączników - nie działa skrypt VBA

Postprzez OShon » Pn 08.10.2018 10:31

W warunku używam objAtt.FileName zamiast objAtt.DisplayName
Sprawdź czy w twoim przypadku robi to różnicę - choć podejrzewam że nie.

U mnie, nie ma to różnicy - pobierają się same JPG
Kod: Zaznacz cały
Sub Wywolaj_test()
Dim item As MailItem
For Each item In Application.ActiveExplorer.Selection
    Call saveAttachtoDisk(item)
Next
End Sub

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    Dim dateFormat
    dateFormat = Format(itm.ReceivedTime, "yyyy-mm-dd hh-mm")
    saveFolder = "C:\Temp"
    For Each objAtt In itm.Attachments
       If UCase(Mid(objAtt.FileName, InStrRev(objAtt.FileName, "."))) = ".JPG" Then
        objAtt.SaveAsFile saveFolder & "\" & dateFormat & " " & objAtt.FileName & _
            " " & Split(itm.SenderEmailAddress, "@")(0)
       End If
    Next
End Sub

Przy zamianie objAtt.SaveAsFile na Debug.Print
otrzymuje listę samych JPG - którą sam możesz sobie sprawdzać właśnie w ten sam sposób: (oknem immediate Ctrl+g)

Przechwytywanie.PNG
Przechwytywanie.PNG (10.09 KiB) Przeglądane 659 razy

Jak pow widać część to zdjęcia treści maila (zawsze to image*.jpg), ale 2 wpadają z załącznika. :D
Obrazek
Oskar Shon - MVP Office System/Development 11/19, 3x MCC
Forum moderator: Outlook.pl | ExcelForum.pl | MSDN dział VBA
Zobacz fajne dodatki: Outlooka, Excela, Worda lub PowerPointa
OShon
 
Posty: 9687
Dołączył(a): Cz 19.10.2006 08:31
Lokalizacja: Projekt autorski VBATools.pl

Re: Automatyczny zapis załączników - nie działa skrypt VBA

Postprzez blazejp » Pn 08.10.2018 11:57

Kurde, teraz to już się pogubiłem.
Jak to możliwe że ten pierwotny kod(nr 1 poniżej) działa i zapisuje mi wszystkie załączniki, a ten zmodyfikowany przez ciebie (nr 2 poniżej), to nie zapisuje nic..
FileName na FileDisplay zmieniłem i tez nic

Rozumiem , ze nie ma żadnej konsolki albo logów które można podejrzeć co tutaj nie działa?:P

Kod: Zaznacz cały
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    Dim dateFormat
    dateFormat = Format(itm.ReceivedTime, "yyyy-mm-dd H-mm")
    saveFolder = "C:\Temp"
    For Each objAtt In itm.Attachments
        objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
    Next
End Sub



Kod: Zaznacz cały
Sub Wywolaj_test()
Dim item As MailItem
For Each item In Application.ActiveExplorer.Selection
    Call saveAttachtoDisk(item)
Next
End Sub

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    Dim dateFormat
    dateFormat = Format(itm.ReceivedTime, "yyyy-mm-dd hh-mm")
    saveFolder = "C:\Temp"
    For Each objAtt In itm.Attachments
       If UCase(Mid(objAtt.FileName, InStrRev(objAtt.FileName, "."))) = ".JPG" Then
        objAtt.SaveAsFile saveFolder & "\" & dateFormat & " " & objAtt.FileName & _
            " " & Split(itm.SenderEmailAddress, "@")(0)
       End If
    Next
End Sub
blazejp
 
Posty: 8
Dołączył(a): Wt 02.10.2018 14:14

Re: Automatyczny zapis załączników - nie działa skrypt VBA

Postprzez OShon » Pn 08.10.2018 12:27

Widzę że mamy tutaj lekcję od podstaw :P
Ależ można podejrzeć - tylko zapewne się z tym jak do tej pory, nie spotkałeś.

Pisałem powyżej o oknie immediate? prawda i poleceniu który wysyła do niego efekt pracy kodu (np stringa który będzie nazwą pliku).
Możesz też użyć breaking pointa aby przechodząc linia po linii zobaczyć jakie obiekty są łapane i jakie zaliczają się w warunku.
Takie debugowanie można wykonać stawiając Kropkę, albo polecenie STOP (j.n.)

XL_VBA_Breaking_point.png
XL_VBA_Breaking_point.png (7.38 KiB) Przeglądane 655 razy

Nie wykluczone że skoro wywołałeś procedurę dla zaznaczonych maili, żaden z zaznaczonych nie miał grafiki w załącznikach :)
POtestuj obie metody sprawdzania kodu.
Obrazek
Oskar Shon - MVP Office System/Development 11/19, 3x MCC
Forum moderator: Outlook.pl | ExcelForum.pl | MSDN dział VBA
Zobacz fajne dodatki: Outlooka, Excela, Worda lub PowerPointa
OShon
 
Posty: 9687
Dołączył(a): Cz 19.10.2006 08:31
Lokalizacja: Projekt autorski VBATools.pl

Re: Automatyczny zapis załączników - nie działa skrypt VBA

Postprzez blazejp » Pn 08.10.2018 12:52

Noo sorry, programowaniem nie zajmowałem się nigdy :P

Ale chyba rozkminiłem w czym może byc problem. Skrypt działa jeśli ma zapisywac nazwe pliku jako data + nazwapliku (kod poniżej nr 1)

natomiast jak wkleje kod zeby nazwa pliku była data + nazwa pliku + nazwa z maila przed @ , to nic się nie zapisuje:< (kod poniżej nr 2)


Kod: Zaznacz cały
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    Dim dateFormat
    dateFormat = Format(itm.ReceivedTime, "yyyy-mm-dd hh-mm")
    saveFolder = "C:\Users\mjardim\Desktop\Zalaczniki"
    For Each objAtt In itm.Attachments
       If UCase(Mid(objAtt.FileName, InStrRev(objAtt.FileName, "."))) = ".PDF" Then
     objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.FileName
       End If
    Next
End Sub



Kod: Zaznacz cały
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    Dim dateFormat
    dateFormat = Format(itm.ReceivedTime, "yyyy-mm-dd hh-mm")
    saveFolder = "C:\Users\mjardim\Desktop\Zalaczniki"
    For Each objAtt In itm.Attachments
       If UCase(Mid(objAtt.FileName, InStrRev(objAtt.FileName, "."))) = ".PDF" Then
      objAtt.SaveAsFile saveFolder & "\" & dateFormat & " " & objAtt.FileName & _
            " " & Split(itm.SenderEmailAddress, "@")(0)
       End If
    Next
End Sub
blazejp
 
Posty: 8
Dołączył(a): Wt 02.10.2018 14:14

Re: Automatyczny zapis załączników - nie działa skrypt VBA

Postprzez OShon » Pn 08.10.2018 13:25

W takim razie albo adresat twój nie ma małpy w adresie albo masz starą wersję, która nie miała jeszcze parametru SenderEmailAddress
Stąd błąd i opuszczenie realizacji takiej reguły.
Jak pokazałem pow u mnie działa, również pobierając nazwę konta z adresu email.
Obrazek
Oskar Shon - MVP Office System/Development 11/19, 3x MCC
Forum moderator: Outlook.pl | ExcelForum.pl | MSDN dział VBA
Zobacz fajne dodatki: Outlooka, Excela, Worda lub PowerPointa
OShon
 
Posty: 9687
Dołączył(a): Cz 19.10.2006 08:31
Lokalizacja: Projekt autorski VBATools.pl


Powrót do Microsoft Outlook 2007 / 2010 / 2013 / 2016

Kto przegląda forum

Użytkownicy przeglądający ten dział: Google [Bot], OShon i 22 gości