< návrat zpět

MS Excel

Téma: Soubor nenalezen - MacOS rss

Zaslal/a Alfan 5.6.2023 10:04

AlfanDobrý den,
prosím, můžete mi někdo poradit (zeditovat), proč se nenajde na MacBook ten soubor uložený v adresáři "data-platby"?
Adresář je uložen ve stejném adresáři, jakou sešit, ve kterém spouštím to makro.
Na WIN to funguje velmi dobře od doby, kdy mi to pomohl @elninoslov napsat.
Děkuji.
Radek
Sub doPDF_bezCOPY_proHS_adresář()

Dim sDir As String, sSoubor As String, sDate As String, sKod As String, MAIL_ADRESAT As String
Dim bTypSpravy As Byte, bOteviranyOutlook As Boolean, MyDate As Date
Dim OutApp As Object, OutMail As Object ', oUcet As Object

'Const ODESILATEL_MAIL = "elninoslov@gmail.com" 'v případě vícero účtů v Outlooku se bude odesílat z tohoto
Const ZAVRIT_OUTLOOK = True 'v případě, že Outlook otevře makro, má ho pak zavřít (True) nebo nechat otevřen (False)
Const ODESLAT_MAIL = False 'True - mail odešle, False - mail pouze vytvoří


'příprava adresáře

With ThisWorkbook.ActiveSheet 'toto pracuje s aktuálním Listem

sKod = .Range("B2").Value2 'kód hospodářského střediska
sDir = ThisWorkbook.Path & "\Export\" & sKod & "\" 'nastavení adresáře referenta do složky Export

'sDir = ThisWorkbook.Path & "\__pdfhs - " & sKod & "\" 'nastavení adresáře hospodářského střediska

'sDir = ThisWorkbook.Path & "\__pdfhs\" 'původní nastavení do přímo zvoleného adresáře

If Len(Dir(sDir, vbDirectory)) = 0 Then 'kontrola existence adresáře hospodářského střediska
If MsgBox("Adresář neexistuje." & vbNewLine & vbNewLine & "Přejete si ho vytvořit?" & vbNewLine & vbNewLine & sDir, vbYesNo + vbQuestion) = vbNo Then Exit Sub
If Not Vytvor_Adresarovou_Strukturu(sDir) Then bTypSpravy = 1: GoTo KONEC 'chybová správa o vytváření adresáře
End If

sDate = Format(Date, "yyyy-mm-dd") 'Rozhoduje pořadí, bere se ta poslední varianta, řádek

'příprava souboru

On Error Resume Next

'MAIL_ADRESAT = "niekto@odniekial.com" 'konkrétní adresát
MAIL_ADRESAT = "" 'adresát je prázdný

'MAIL_ADRESAT = .Range("B5").Value2 'adresát z konkrétní buňky, nebo adresáti v buňce oddělení středníkem

sSoubor = sDir & .Range("B1").Value2 & "-" & .Range("A1").Value2 & " _ " & sKod & ".pdf" 'složí název souboru
'sSoubor = sDir & sDate & " - " & sKod & " - " & .Name & ".pdf" 'složí název souboru
.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=sSoubor, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False 'export do PDF
End With

If Err.Number <> 0 Then bTypSpravy = 2: GoTo KONEC 'chybová správa o vytváření souboru

'příprava Outlooku

'Set OutApp = GetObject(, "Outlook.application") 'ověření, zda není Outlook otevřený

'If OutApp Is Nothing Then
'Set OutApp = CreateObject("Outlook.Application") 'otevření Outlooku, pokud není otevřen
'If Not OutApp Is Nothing Then bOteviranyOutlook = True Else bTypSpravy = 3: GoTo KONEC 'chybová správa o otvírání Outlooku
'End If
'On Error GoTo 0

'For Each oUcet In OutApp.Session.Accounts 'v případě vícero účtů v Outlooku, nalezení toho, z kterého se má odesílat
' If oUcet.CurrentUser.Address = ODESILATEL_MAIL Then Exit For
'Next oUcet

'If oUcet Is Nothing Then bTypSpravy = 4: GoTo KONEC 'chybová správa - požadovaný účet není v Outlooku nalezen


'příprava mailu

'On Error Resume Next
'Set OutMail = OutApp.CreateItem(0) 'vytvoření emailu
'With OutMail
' .To = MAIL_ADRESAT 'adresát
' .CC = ""
' .BCC = ""
' .Subject = "Pohledávky po splatnosti HS " & sKod
' .Body = "Posíláme pohledávky po splatnosti pro HS " & sKod
'.Attachments.Add sSoubor
'Set .SendUsingAccount = oUcet 'Odesílá pomocí zvoleného účtu

'If ODESLAT_MAIL Then .Send 'Else .Display 'podle volby se mail odešle (True), nebo pouze vytvoří (False)
'End With
'If Err.Number <> 0 Then bTypSpravy = 5
'On Error GoTo 0

'vyhodnocení

KONEC:
'AppActivate ThisWorkbook.Windows(1).Caption

Select Case bTypSpravy 'vyhodnocení - správa o chybách
'Case 0: MsgBox "Vytvoření PDF - OK" & vbNewLine & IIf(ODESLAT_MAIL, "Odeslání", "Vytvoření") & " mailu - OK", vbInformation
Case 0: MsgBox "Vytvoření PDF - OK", vbInformation
If Not ODESLAT_MAIL And Not OutMail Is Nothing Then OutMail.Display 'zobrazení vytvořeného emailu
Case 1: MsgBox "Tento adresář nebylo možné vytvořit !" & vbNewLine & vbNewLine & sDir, vbCritical
Case 2: MsgBox "Nastala chyba při vytváření souboru !" & vbNewLine & vbNewLine & sSoubor, vbCritical
Case 3: MsgBox "Není možné otevřít Outlook !" & vbNewLine & vbNewLine & sSoubor, vbCritical
'Case 4: MsgBox "Vytvoření PDF - OK" & vbNewLine & "Odeslání mailu - účet neexistuje ( " & ODESILATEL_MAIL & " )", vbExclamation
Case 5: MsgBox "Vytvoření PDF - OK" & vbNewLine & "Odeslání mailu - chyba !", vbExclamation
If Not ODESLAT_MAIL And Not OutMail Is Nothing Then OutMail.Display 'zobrazení vytvořeného emailu
End Select

'v případě, že Outlook byl otvíraný makrem, mail hned odesílaný (ODESLAT_MAIL=True), a je třeba ho zavřít (ZAVRIT_OUTLOOK=True) - tak se zavře
'If bOteviranyOutlook And ZAVRIT_OUTLOOK And ODESLAT_MAIL Then OutApp.Quit

'zrušení objektů
Set OutApp = Nothing: Set OutMail = Nothing ': Set oUcet = Nothing
End Sub

Function Vytvor_Adresarovou_Strukturu(ByVal sDir As String) As Boolean 'Vytvoření adresářové struktury, včetně podadresářů
Dim F() As String, i As Integer

F = Split(sDir, "\") 'rozdělí cestu na podadresáře
sDir = ""

With CreateObject("Scripting.FileSystemObject")
On Error Resume Next
For i = 0 To UBound(F) - 1 'postupně kontroluje a vytváří podadresáře (poslední lomítko vynechá - ošetřeno na začátku)
sDir = sDir & IIf(Len(sDir) = 0, "", "\") & F(i)
If Not .FolderExists(sDir) Then .CreateFolder sDir
Next i
End With

Vytvor_Adresarovou_Strukturu = Err.Number = 0 'False - když nastala chyba
End Function

'Sub Vypis_Uctov_Outlooku() 'pouze kontrolní makro pro výpis seznamu účtů v Outlooku a jejich adres
'Dim OutApp As Object, oUcet As Object
'
' On Error Resume Next
' Set OutApp = GetObject(, "Outlook.application") 'ověření, zda není Outlook otevřený
'
' If OutApp Is Nothing Then
' Set OutApp = CreateObject("Outlook.Application") 'otevření Outlooku, pokud není otevřen
' If OutApp Is Nothing Then Debug.Print "CHYBA" 'chybová správa o otvírání Outlooku
' End If
' On Error GoTo 0
'
' For Each oUcet In OutApp.Session.Accounts 'výpis účtů
' Debug.Print oUcet & "......." & oUcet.CurrentUser.Address
' Next oUcet
'
' Set OutApp = Nothing: Set oUcet = Nothing
'End Sub

Zaslat odpověď >
Milan-158(7.6.2023 9:29)#054992
avatar
Ten uvedený kód pracuje s adresářovou strukturou Windows, kde jsou úrovně složek oddělovány zpětným lomítkem. Mám nejasné tušení, že Macbook používá normální lomítko.
Zkus v kódu nahradit \ za / a krokuj to pomocí F8 a v Locals Window si kontroluj hodnoty proměnných - takhle poznáš kde je problémcitovat
Alfan(7.6.2023 9:43)#054993
Alfan
EDIT
Tak když se soubor vyexportuje z Informačního systému na počítači s win, tak vše funguje korektně.
Pokud však kolega exportuje soubor z Informačního systému na Mac tak to nefunguje.
Po exportu na Mac ten vyexportovaný soubor ani neotevře, ale jen ho zkopíruje na počítač s win a pak ho chce načíst, tak to nefunguje.
Takže to bude vše dělat na počítači s win a je to.
__________________
Díky za info.
Jenže mě to někdy nejde ani na windows a ukazuje mi to chybu na tomto řádku
If FileDateTime(sDir & sFileTemp) > dFileTime Then
a vůbec netuším, čím to je?
Musí tam tento řádek být, nedalo by se to nějak eliminovat?
Myslel jsem, že to mohlo být i nějakou diakritikou v názvech souborů nebo tak, ale fakt nevím.
Ten Mac už řešit nebudu, kolega si to může spustit na win.
Přikládám zdroje.
Děkuji.
Radekcitovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Formulář Faktura

Formulář Faktura V

Nová verze. Formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Helios iNuvio

Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.

On-line nástroje