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: 203
Registrován: únor 12
Pohlaví: Nespecifikováno
Stav:
Offline

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: 366
Registrován: červen 13
Pohlaví: Muž
Stav:
Offline

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: 203
Registrován: únor 12
Pohlaví: Nespecifikováno
Stav:
Offline

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: 366
Registrován: červen 13
Pohlaví: Muž
Stav:
Offline

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: 203
Registrován: únor 12
Pohlaví: Nespecifikováno
Stav:
Offline

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: 366
Registrován: červen 13
Pohlaví: Muž
Stav:
Offline

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: 203
Registrován: únor 12
Pohlaví: Nespecifikováno
Stav:
Offline

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: 366
Registrován: červen 13
Pohlaví: Muž
Stav:
Offline

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
  • VBA Excel 365 vložit obrazek do buňky
    od wlk60 » 19 dub 2023 15:43 » v Kancelářské balíky
    1
    1628
    od atari Zobrazit poslední příspěvek
    19 dub 2023 21:53
  • Excel - filtr na formát buňky + obsah Příloha(y)
    od popcorn » 19 zář 2023 17:07 » v Kancelářské balíky
    0
    1865
    od popcorn Zobrazit poslední příspěvek
    19 zář 2023 17:07
  • Tisk ELD souboru
    od Jandak » 30 dub 2023 09:53 » v Problémy s hardwarem
    4
    1103
    od Grander Zobrazit poslední příspěvek
    09 čer 2023 21:31
  • Přenos souborů SD - USB flash bez PC
    od Asanoth » 29 črc 2023 17:35 » v Sítě - hardware
    11
    2032
    od Grander Zobrazit poslední příspěvek
    30 črc 2023 15:20
  • Jak hromadně změnit datum a čas souborů?
    od atari » 11 črc 2023 14:41 » v Programování a tvorba webu
    2
    2334
    od atari Zobrazit poslední příspěvek
    13 črc 2023 10:52

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

Kdo je online

Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 3 hosti