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: 142
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
guest
Pohlaví: Nespecifikováno

Re: Přestal mi fungovat kód

Příspěvekod guest » 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é.

luko02420
Level 1.5
Level 1.5
Příspěvky: 142
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…
    7
    943
    od Pepe3dx
    16 čer 2019 22:01
  • Externí HDD WD Elements přestal fungovat
    od Psenda15 » 28 úno 2019 12:28 » v Problémy s hardwarem
    0
    437
    od Psenda15
    28 úno 2019 12:28
  • 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
    1105
    od ibro79
    16 bře 2019 20:36
  • Kancelářský balík Office přestal náhle fungovat
    od Phoe » 13 čer 2019 14:14 » v Kancelářské balíky
    0
    570
    od Phoe
    13 čer 2019 14:14
  • WI-FI přestala fungovat
    od Shadehazard » 28 lis 2019 17:15 » v Sítě - hardware
    9
    434
    od ITCrowd
    28 lis 2019 19:44

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

Kdo je online

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