Cesta pro uložení souboru podle obsahu buňky Vyřešeno

Programy pro práci v kanceláři (Word, Excel, Access…=>Office)

Moderátor: Mods_senior

luko02420
Level 2
Level 2
Příspěvky: 169
Registrován: únor 12
Pohlaví: Nespecifikováno

Cesta pro uložení souboru podle obsahu buňky

Příspěvekod luko02420 » 18 dub 2020 02:50

Zdravím všechny místní odborníky. Používám makro pro uložení listu do pdf a následné odeslání pdf emailem.
Potřeboval bych makro upravit a to tak, aby se mi pdf uložilo do složky podle obsahu buňky F7.
Teď je cesta nastavena do jednoho místa a pdf musím vždy ručně přesouvat do dané složky.
Žlutě označená část cesty v kódu musí být zachována
Složka pro uložení je vždy vytvořena před ukládáním souboru.
Děkuji všem za pomoc.

Kód: Vybrat vše

Sub OutlookPrilohav()
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("G13") ' 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
       
     
        Soubor = "[highlight=yellow]Z:\Mistr výroby\Neshodný výrobek[/highlight]\" & .Range("F7") & "_" & .Range("D14") & "_" & .Range("M2") & "" & ".pdf" ' Tady se vylní cesta kam chcete soubor uložit, C35
             .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 = Range("O1") ' emailová adresa příjemce
   
   
    With OutMail
        'adresát
        .To = adresat
       
        'kopie pro
        '.CC = Range("R2")
       
        'skrytá kopie pro
        '.BCC = ""
               
        'předmět zprávy
        .Subject = "Protokol"
       
             
        '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
     
     
    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



Reklama
Uživatelský avatar
elninoslov
Level 2.5
Level 2.5
Příspěvky: 271
Registrován: červen 13
Pohlaví: Muž

Re: Cesta pro uložení souboru podle obsahu buňky

Příspěvekod elninoslov » 18 dub 2020 13:59

Treba ujasniť pár vecí.
Čo myslíte pod pojmom "do zložky" ?

Kód: Vybrat vše

C:\niečo\obsah F7\

alebo

Kód: Vybrat vše

obsah F7


Daná zložka/podzložka existuje, alebo sa má vytvoriť?

Určite F7? Lebo F7 je súčasť názvu súboru.

Určite chcete nahradiť to čo je v tagu Highlight za obsah bunky F7 ? Opäť lebo F7 je súčasť názvu súboru.

luko02420
Level 2
Level 2
Příspěvky: 169
Registrován: únor 12
Pohlaví: Nespecifikováno

Re: Cesta pro uložení souboru podle obsahu buňky

Příspěvekod luko02420 » 18 dub 2020 18:24

Dobrý den, je mysleno to co uvadite C:\neco\obsah F7\.
Daná podsložka bude existovat.
F7 je název podsložky a součastně i část názvu souboru

Uživatelský avatar
elninoslov
Level 2.5
Level 2.5
Příspěvky: 271
Registrován: červen 13
Pohlaví: Muž

Re: Cesta pro uložení souboru podle obsahu buňky

Příspěvekod elninoslov » 18 dub 2020 22:46

Tak iba doplnte zložku a podzložku, napr.:

Kód: Vybrat vše

Sub OutlookPrilohav()
Dim objNsp As Object, colSyc As Object, objSyc As Object, i As Integer, adresat As String, Soubor As String
Dim Slozka As String, Podslozka 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
   
   Slozka = "Z:\Mistr výroby\Neshodný výrobek\"

    With ActiveSheet
        Podslozka = .Range("F7").Value
        If Len(Podslozka) < 2 Or Len(Dir(Slozka & Podslozka, vbDirectory)) = 0 Then MsgBox "Špatně zadaná složka v F7.", vbCritical: Exit Sub
       
        With .Range("G13") ' 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
       
        Soubor = Slozka & Podslozka & "\" & Podslozka & "_" & .Range("D14") & "_" & .Range("M2") & ".pdf"  ' Tady se vylní cesta kam chcete soubor uložit, C35
             .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 = Range("O1") ' emailová adresa příjemce
   
   
    With OutMail
        'adresát
        .To = adresat
       
        'kopie pro
        '.CC = Range("R2")
       
        'skrytá kopie pro
        '.BCC = ""
               
        'předmět zprávy
        .Subject = "Protokol"
       
             
        '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
     
     
    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

luko02420
Level 2
Level 2
Příspěvky: 169
Registrován: únor 12
Pohlaví: Nespecifikováno

Re: Cesta pro uložení souboru podle obsahu buňky

Příspěvekod luko02420 » 19 dub 2020 13:52

Dobrý den, opět výborná práce,
Jenom si nevím rady s malou drobností, zapomněl jsem Vám říct, že do F7, mi hodnotu doplňuje vzorec. Takže kod nefunguje. Jakmile F7 vyplním ručně jede bez problému.
Omlouvám se za chybu.
Pise mi to, že dokument nebyl ulozen nebo je otevren, nebo doslo k chybe pri ukladáni. Tato cast kodu je zluta

Kód: Vybrat vše

.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Soubor, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

Uživatelský avatar
elninoslov
Level 2.5
Level 2.5
Příspěvky: 271
Registrován: červen 13
Pohlaví: Muž

Re: Cesta pro uložení souboru podle obsahu buňky

Příspěvekod elninoslov » 19 dub 2020 23:41

A čo je v tej bunke? Aký vzorec a čo je jeho výsledkom?

luko02420
Level 2
Level 2
Příspěvky: 169
Registrován: únor 12
Pohlaví: Nespecifikováno

Re: Cesta pro uložení souboru podle obsahu buňky

Příspěvekod luko02420 » 20 dub 2020 07:04

Kód: Vybrat vše

=KDYŽ(M7>0;M7;"")

Do F7 se kopíruje se název firmy, který se do M7 zapisuje z comboboxu.
Vím že je to krkolomné ale před touto úpravou to normálně fungovalo.
Jenom me napadlo nebylo by lepsi to makro na ukladaní co jste mi napsal udelat jako samostatné makro?

Uživatelský avatar
elninoslov
Level 2.5
Level 2.5
Příspěvky: 271
Registrován: červen 13
Pohlaví: Muž

Re: Cesta pro uložení souboru podle obsahu buňky  Vyřešeno

Příspěvekod elninoslov » 20 dub 2020 10:44

Ak je ComboBox napojený na M7, tak do F7 žiaden názov firmy nedostanete. Lebo ComboBox vkladá do bunky M7 číslo indexu v zozname, nie textovú hodnotu názvu firmy. Takže sa odkazujete asi na neexistujúci adresár s číslom, nie názvom firmy. Nedávkujte ďalšie info, ale poskytnite prílohu. Zbavte ju citlivých dát, ale ponechajte formáty, vzorce a obdobné zadané vymyslené údaje v dotyčných bunkách a ComboBoxe.


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • PHP načtení obsahu ze souboru jako proměnná
    od Diesels » 23 lis 2019 13:00 » v Programování a tvorba webu
    2
    1238
    od Diesels
    24 lis 2019 10:24
  • Pracovní cesta
    od behavioralista » 10 kvě 2020 11:38 » v Vše ostatní (Off topic)
    2
    368
    od mmmartin
    10 kvě 2020 13:51
  • django formtool uložení dat do modelu
    od Akrej » 13 zář 2020 18:05 » v Programování a tvorba webu
    0
    217
    od Akrej
    13 zář 2020 18:05
  • Přenos obsahu mobilu do jiného přes zálohu.
    od mmmartin » 22 zář 2020 14:00 » v Mobily, tablety a jiná přenosná zařízení
    2
    174
    od mmmartin
    22 zář 2020 14:40
  • Makro kopirovani do prazdne bunky
    od 8700 » 01 úno 2020 09:11 » v Kancelářské balíky
    0
    825
    od 8700
    01 úno 2020 09:11

Zpět na “Kancelářské balíky”

Kdo je online

Uživatelé prohlížející si toto fórum: CommonCrawl [Bot] a 3 hosti