VBA makro rada

[Dusan150]

Dobrý deň
Mám na vás prosbu o radu resp. pomoc
Potrebujem priradiť makro v súbore excel (v prílohe) tak, aby sa daný hárok uložil na disk v PC z názvom daného hárku s reálnym dátumom a zároveň bol odoslaný na konkrétnu mailovú adresu.

[luko02420]

Dobrý den, zkuste toto mělo by to být co potřebujete. Mám to od místních odborníků. Budete muset jenom upravit cestu atd.
Odesílá to v PDF ale jde to přenastavit i na celý sešit.

Kód: Vybrat vše

Sub OutlookPriloha()
Dim objNsp As Object, colSyc As Object, objSyc As Object, i As Integer, adresat As String, Soubor As String
    '!!!!!Před použitím je třeba v Tools / References zaškrtnout volbu Microsoft Outlook xx.0 Object Library.!!!!!
    'Tools / References / Microsoft Outlook x.x Object Library
   
    With ActiveSheet
        With .Range("C39")
            .Value = Now()
            .NumberFormat = "d/m/yy h:mm;@"
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        Range("D37").Value = "bb@cosi.cz"
        Range("D38").Value = "bb@cosi.cz"
        
      ' Uložení souboru
      'Range C35 = datum
      'Range L1 = Jméno
      
        Soubor = "C:umístnění\" & .Range("C35") & " " & .Range("L1") & ".pdf"
        
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=Soubor, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    End With
   
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    Set objNsp = OutApp.Application.GetNamespace("MAPI")  'CORRECTION to Refer to the OutLook Application correctly
    Set colSyc = objNsp.SyncObjects
   
    adresat = "bbb@cosi.cz"
   
   
    With OutMail
        'adresát
        .To = adresat
    
        'kopie pro
         .CC = "bbb@cosi.cz"
        
        'kopie pro
        '.CC = "bbb@cosi.cz"
        
        'skrytá kopie pro
        .BCC = "bbb@cosi.cz"
        
        'předmět zprávy
        .Subject = "Vepiš text"
        
        'text zprávy a určení buňky
        .Body = "Text zprávy"
       
        'aktivní (uložený) sešit jako příloha
        .Attachments.Add Soubor
       
        'Nastavení preferovaného účtu pro odeslání pošty - v tomto případě druhý v pořadí
        'Dostupné od verze Office 2007
        .SendUsingAccount = OutApp.Session.Accounts.Item(1)
        'odeslání zprávy
        .Send
       
    End With
    Range("D37:D38").ClearContents
    Range("C39").ClearContents
    Range("B6:J20").ClearContents
    Range("B24:J33").ClearContents
   
    For i = 1 To colSyc.Count
        Set objSyc = colSyc.Item(i)
        objSyc.Start
    Next i
    'OutApp.Quit
    MsgBox "Zpráva byla odeslána na adresu: " & adresat, vbInformation
    'uvolnění z paměti
    Set OutMail = Nothing: Set objNsp = Nothing: Set colSyc = Nothing: Set objSyc = Nothing: Set OutApp = Nothing
End Sub

[Dusan150]

Ďakujem za odpoveď, ale nepodarilo sa mi to spraviť. Som vo VBA začiatočník

[luko02420]

Zkusím Vám to vysvětlit snad mě tu někdo neukamenuje.
Celou proceduru vložit do modulu makra. Nevím jak se přesně co nazívá ale snad si poradíte
Procedura se spuští tlačítkem. ( vložit objekt a přiřadit makro)
Taky nejsem žádný expert každou chvíli mě tu někdo radí.
Hlavně nezapomět si přečíst hned druhou větu v proceduře.

Kód: Vybrat vše

Sub OutlookPriloha()
Dim objNsp As Object, colSyc As Object, objSyc As Object, i As Integer, adresat As String, Soubor As String
    '!!!!!Před použitím je třeba v Tools / References zaškrtnout volbu Microsoft Outlook xx.0 Object Library.!!!!!
    'Tools / References / Microsoft Outlook x.x Object Library
   
    With ActiveSheet
        With .Range("C39") ' toto je buňka kde se na listě vypíše datum a čas
            .Value = Now()
            .NumberFormat = "d/m/yy h:mm;@"
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        Range("D37").Value = "bb@cosi.cz" 'emailové adresy, které se vloží do uloženého dokumentu
        Range("D38").Value = "bb@cosi.cz"
       
      ' Uložení souboru
      'Range C35 = datum
      'Range L1 = Jméno
     
        Soubor = "C:umístnění\" & .Range("C35") & " " & .Range("L1") & ".pdf" ' Tady se vylní cesta kam chcete soubor uložit, C35      
       A L1 název a datum souboru pod, kterým se uloží.
       
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=Soubor, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    End With
   
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    Set objNsp = OutApp.Application.GetNamespace("MAPI")  'CORRECTION to Refer to the OutLook Application correctly
    Set colSyc = objNsp.SyncObjects
   
    adresat = "bbb@cosi.cz" ' emailová adresa příjemce
   
   
    With OutMail
        'adresát
        .To = adresat
   
        'kopie pro
         .CC = "bbb@cosi.cz"
       
         'skrytá kopie pro
        .BCC = "bbb@cosi.cz"
       
        'předmět zprávy
        .Subject = "Vepiš text" 'Sem si napíšete předmět odesílané zprávy
       
        'text zprávy a určení buňky
        .Body = "Text zprávy"  'obsah zprávy
       
        'aktivní (uložený) sešit jako příloha
        .Attachments.Add Soubor
       
        'Nastavení preferovaného účtu pro odeslání pošty - v tomto případě druhý v pořadí
        'Dostupné od verze Office 2007
        .SendUsingAccount = OutApp.Session.Accounts.Item(1)
        'odeslání zprávy
        .Send
       
    End With
    Range("D37:D38").ClearContents  'Vymaže buňky
    Range("C39").ClearContents
    Range("B6:J20").ClearContents
    Range("B24:J33").ClearContents
   
    For i = 1 To colSyc.Count
        Set objSyc = colSyc.Item(i)
        objSyc.Start
    Next i
    'OutApp.Quit
    MsgBox "Zpráva byla odeslána na adresu: " & adresat, vbInformation
    'uvolnění z paměti
    Set OutMail = Nothing: Set objNsp = Nothing: Set colSyc = Nothing: Set objSyc = Nothing: Set OutApp = Nothing
End Sub

[Dusan150]

Ďakujem pekne za snahu
Som amatér v tomto a nepodarilo sa mi to spojazdniť.

[luko02420]

Dobrý den, v příloze máte soubor jenom si tam vložte kam to chcete ukládat a adresáta emailu.
Pokud budete chtít odesílat soubor v excelu tak dejte vedět večer bych Vám ho poslal.
Snad Vám to pomůže.
Ještě název listu neumím vložit přímo do procedury tak je tam pomocná buňka L2
Zapoměl jsem Vám tam dat tlacitko na spousteni makra

[Dusan150]

Poprosím aj o tú úpravu aby sa to odosielalo v excelovom formáte.
Ďakujem veľmi ste mi pomohli

[luko02420]

Dobrý večer, posílám slíbené.
Rád pomůžu, ale není to má práce. Vytvořil Elninoslov tomu patří dík.
Vyzkoušejte a uvidíte.

[Dusan150]

Ďakujem vám aj Elninoslovi
Keďže pri odoslaní v exceli sa príjemcovi zobrazí aj oblasť kde je makro, bude lepšia verzia v PDF (príjemca nemusí dokument upravovať)
Lenže teraz nastal problém s tým že keď zabezpečím hárok tak makro sa nespustí :(

[luko02420]

Jestli to správně chápu, pokud se odesílá sešit v PDF tak přece není potřeba zabezpečovat list.

[Dusan150]

ten problém s makrom som vyriešil vo VBA som na začiatku zadal odomknúť a na konci zamknut harok, pretože ten hlavný excel súbor bude používať cca 30 ľudí tak aby nedošlo k nedovoleným zásahom do štruktúry ap.
Lenže keď už bolo všetko hotové preniesol som súbor do PC v ktorom má byť používaný a po upravení makra súbor odošle na danú adresuale vo VBA mi vyhodí hlášku Run- time error´1004´: čiže súbor neuloží a keď otvorím Debug zobrazuje:

[luko02420]

To je zajimave me to funguje. Ale mam obavu ze Vám nedokazi poradit. Snad jenom info, me se to stalo taky, ze jsem doma vytvoril sesit a v praci mi z nejakeho duvodu nefungoval. Tak jsem proste vytvoril to stejne v praci a byl klid.
Vím ze to neni zadna rada ale opravdu jsem laik. Omlouvám se.