Thema Datum  Von Nutzer Rating
Antwort
04.08.2018 00:57:47 Piet
NotSolved
04.08.2018 04:53:15 Gast55605
NotSolved
04.08.2018 09:01:17 Gast58428
NotSolved
04.08.2018 19:47:44 Gast27503
***
NotSolved
04.08.2018 21:25:25 Gast13567
NotSolved
04.08.2018 21:47:04 Gast38093
NotSolved
Rot für Dateipfade in Unicode muss man dann schon auf die Windows API zugreifen
 05.08.2018 12:31:54 Gast27503
NotSolved
05.08.2018 14:50:50 Gast47764
****
NotSolved

Ansicht des Beitrags:
Von:
Gast27503		 Datum:
05.08.2018 12:31:54		 Views:
797		 Rating:
     
Antwort:
  Ja
Thema:
für Dateipfade in Unicode muss man dann schon auf die Windows API zugreifen		 
Option Explicit

#If VBA7 Then

' available with Windows XP Service Pack 2 (SP2) and higher
Private Declare PtrSafe Function SHCreateDirectoryExW Lib "shell32" ( _
  ByVal hWnd As LongPtr, _
  ByVal lpszPath As String, _
  ByVal lpSA As LongPtr _
) As Long

#End If

Public Sub Demo()
  
  Dim strPath As String
  
  'path
  strPath = StrConv("D:\" & Range("B3"), vbUnicode)
  
  If Not MakeSureDirectoryPathExistsW(strPath) Then
    Call MsgBox("Fehler", vbCritical)
'  Else
'    '...
  End If
  
  '...
  
End Sub

Public Function MakeSureDirectoryPathExistsW(ByVal DirPath As String) As Boolean
   
   Const PROC_NAME As String = "MakeSureDirectoryPathExistsW"
   
   Dim retVal As Long
   
   retVal = SHCreateDirectoryExW(0&, DirPath, 0&)
   
   Debug.Print Format$(Time, "\#hh:mm:ss\#"); Spc(1); PROC_NAME; Spc(1);
   Select Case retVal
    Case &H0:   Debug.Print "returned ERROR_SUCCESS"
    Case &HCE:  Debug.Print "returned ERROR_FILENAME_EXCED_RANGE"
    Case &HA1:  Debug.Print "returned ERROR_BAD_PATHNAME"
    Case &H3:   Debug.Print "returned ERROR_PATH_NOT_FOUND"
    Case &H50:  Debug.Print "returned ERROR_FILE_EXISTS"
    Case &HB7:  Debug.Print "returned ERROR_ALREADY_EXISTS"
    Case &H4C7: Debug.Print "returned ERROR_CANCELLED"
    Case Else:  Debug.Print "returned ERROR_UNKNOWN"
   End Select
   
   MakeSureDirectoryPathExistsW = (retVal = &H0) Or (retVal = &H50) Or (retVal = &HB7)
   
End Function

 

Grüße

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
04.08.2018 00:57:47 Piet
NotSolved
04.08.2018 04:53:15 Gast55605
NotSolved
04.08.2018 09:01:17 Gast58428
NotSolved
04.08.2018 19:47:44 Gast27503
***
NotSolved
04.08.2018 21:25:25 Gast13567
NotSolved
04.08.2018 21:47:04 Gast38093
NotSolved
Rot für Dateipfade in Unicode muss man dann schon auf die Windows API zugreifen
 05.08.2018 12:31:54 Gast27503
NotSolved
05.08.2018 14:50:50 Gast47764
****
NotSolved