Přestal mi fungovat kód Vyřešeno

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

Moderátor: Mods_senior

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

Přestal mi fungovat kód

Příspěvekod luko02420 » 05 dub 2019 08:37

Dobrý den prosím o pomoc. Používám níže uvedený kod na ukladání a odesílání mailu.
Soubor je ulkozený na serveru a pouzívají ho 3 lide. Ted jsem pripojil dalsi PC a kod mi prestal fungovat. Stejný problém ja v diskuzi zde. https://pc-help.cnews.cz/viewtopic.php?f=35&t=206016
VBA mi vyhodí hlášku Run- time error´1004´: a soubor se neuloží.
Postup který je uvedený v diskuzi mi nepomáhá.
Prosím o pomoc. Děkuji.
Tady je prý chyba ale nevím proč.
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Soubor, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

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("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
       
       
      ' Uložení souboru
      'Range C35 = datum
      'Range L1 = Jméno
     
        Soubor = "Z:\dokumenty\" & .Range("F7") & " " & .Range("H3") & "" & .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"
       
        'text zprávy a určení buňky
        .Body = "Prosím vyplňte a obratem zašlete zpět." & Chr(13) & Chr(13) & "Děkuji."
       
        '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("D13:D17").ClearContents
     'Range("F7:I11").ClearContents
     Range("M7:N11").ClearContents
     Range("M21:M29").ClearContents
     Range("M13:M17").ClearContents
    'Range("B41:F46").ClearContents
    'Range("H46").ClearContents
     Range("G13").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



Reklama
xlnc
Level 3.5
Level 3.5
Příspěvky: 883
Registrován: červenec 11
Pohlaví: Muž

Re: Přestal mi fungovat kód

Příspěvekod xlnc » 05 dub 2019 10:53

Stejná chybová hláška neznamená, že máte stejný problém.

a) Zkontrolujte slepování té cesty pro uložení PDF.
b) Napište verzi Excelu, kde to nefunguje.
c) Pošlete to celé.
administrátor ProExcel.cz | lektor | vývojář | léčitel pro Microsoft Excel

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

Re: Přestal mi fungovat kód  Vyřešeno

Příspěvekod luko02420 » 05 dub 2019 13:05

Dobrý den, děkuji za reakci, už jsem na to přišel.
Byla chyba v cestě jak pišete i vy.
každopádně děkuji za reakci.


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • zrazu prestal fungovat zvuk
    od lubo007 » 12 dub 2019 13:35 » v Windows 10, 8, 7, Vista, XP…
    5
    434
    od Coretta97
    11 kvě 2019 09:38
  • Internet přes kabel přestal fungovat
    od Shimuildir » 25 čer 2018 13:02 » v Internet a internetové prohlížeče
    1
    641
    od atari
    25 čer 2018 13:10
  • Excel 2016 auto SUM prestal fungovať
    od Zihos » 24 črc 2018 18:06 » v Kancelářské balíky
    2
    428
    od Zihos
    24 črc 2018 18:38
  • Počítač náhle přestal fungovat(prosím o pomoc)
    od ibro79 » 16 bře 2019 17:13 » v Problémy s hardwarem
    26
    720
    od ibro79
    16 bře 2019 20:36
  • Externí HDD WD Elements přestal fungovat
    od Psenda15 » 28 úno 2019 12:28 » v Problémy s hardwarem
    0
    291
    od Psenda15
    28 úno 2019 12:28

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

Kdo je online

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