< 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.
Radek
Příloha: zip54993_vypocet-mzdy-oz.zip (182kB, staženo 2x)
citovat

Uživatelské menu

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

Menu

Formulář Faktura

Formulář Faktura IV

Oblíbený 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