Relativer Pfad in VBA

[Candalfo]

Hallo liebe Gemeinde,

mir gelingt es gerade nicht, auf eine Datei im selben Ordner mittels VBA zu verweisen. Mit einem absoluten Pfad funktioniert das Script. Da diese Dateien in einem Ordner (Projektzeitenerfassung) weitergegeben werden sollen, möchte ich einen relativen Pfad auf den Ordner setzen.
Mein Fehler liegt hier:  sPath="ThisWorkbook.Path & "\" & "Projektdaten.xls"", weil es mit einem absoluten Pfad funktioniert.
Das System funktioniert so:
- Beide Dateien liegen in einem Ordner mit dem Namen "Projektzeitenerfassung"
- Die Datei "MA_Erfassung_VS_1_0.xlsm" fragt Projektdaten bei der Datei "Projektdaten.xlsx" an und kopiert diese Tabelle per Knopfdruck in die anfragende Tabelle.

Vielen Dank schon einmal für Eure Ideen.

Code:

Sub Query_ProjectData()

Dim sPath As String
Dim wbSource As Workbook

'deactivate ScreenUpdating and PopUps
Application.ScreenUpdating = False
Application.DisplayAlerts = False

'Path of source
sPath="ThisWorkbook.Path & "\" & "Projektdaten.xls""

'Check if file exist
If Dir(sPath) <> "" Then
   
    'Open workbook
    Set wbSource = Workbooks.Open(sPath)
   
    'Copy & paste data
    wbSource.Worksheets(1).Range("A3:B102").Copy ThisWorkbook.Worksheets(3).Range("A3")
   
    'Close workbook
    wbSource.Close SaveChanges:=False
   
End If

'activate ScreenUpdating and PopUps
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

[Elex]

Hi

Was ich auf die schnelle sehe.

sPath="ThisWorkbook.Path & "\" & "Projektdaten.xls""

Eher so.
sPath = ThisWorkbook.Path & "\Projektdaten.xls"

Gruß Elex

[Candalfo]

Hallo Elex,

vielen Dank für Deinen Hinweis. Mit Deiner Information stimmt die Syntax der Zeile, soll heißen, die Fehlermeldung kommt nicht schon nach Eingabe der Zeile.
Jedoch kommt beim Ausführen des Makros die Meldung:
Laufzeitfehler 52
Dateiname oder Nummer falsch.

Das habe ich mehrmals jetzt überprüft, kann aber keinen Fehler finden. Hast Du dazu noch eine Idee?
Ich habe den Pfad im Screenshot in Teilen eingeblendet, mit abslolutem Pfad funktioniert das wunderbar.

   

   

Viele Grüße
Candalfo

[Warkings]

Tja, da hast Du mal wieder alle in die Irre geführt und verschwiegen, dass die Dateien auf One Drive liegen.
Dann liefert ThisWorkbook.Path eine URL und damit kann Dir nichts anfangen und man erhält RTE 52.

Man könnte in diesem Fall folgende Funktion verwenden

PHP-Code:

GetLocalPath (covers UNC/OneDrive/SharePoint paths) 


https://github.com/cristianbuse/VBA-FileTools
https://stackoverflow.com/a/73577057/6600940

[Glausius]

Hallo,

außerdem ist die Extention der Datei unvollständig, denn mit "xls" kann ein modernes Excel nichts anfangen, entweder heißt es "xlsx" oder "xlsm".

[Candalfo]

Hallo Warkings,

nicht mit Absicht...da es mit Onedrive und absoluten Pfaden funktionierte, ging ich nicht davon aus, es würde mit relativen Pfaden nicht funktionieren. Man lernt halt nie aus...
Ich habe jetzt gelernt, dass relative Pfade mit Bordmitteln von Excel in VBA nicht lösbar sind? Leider muss ich mit Bordmitteln von Excel auskommen, externe Libs darf ich nicht einsetzen.

Trotzdem vielen Dank   für Deine Nachricht.

Viele Grüße
Candalfo

---

Hallo Glausius,

vielen Dank für Deinen Hinweis, in meinem initialen Post war das ein Kopierfehler. In der Folge habe ich das behoben.

Viele Grüße
Candalfo

[Warkings]

... Ich habe jetzt gelernt, dass relative Pfade mit Bordmitteln von Excel in VBA nicht lösbar sind? Leider muss ich mit Bordmitteln von Excel auskommen, externe Libs darf ich nicht einsetzen...

VBA kann mit relativen Pfaden umgehen
Die "externe" Library musst Du nur in Dein Projekt kopieren, im Grunde diesen Code in ein eigenes Modul kopieren 
  LibFileTools.txt (Größe: 113,01 KB / Downloads: 6)

Code:

'''=============================================================================
''' VBA FileTools
''' ---------------------------------------------
''' https://github.com/cristianbuse/VBA-FileTools
''' ---------------------------------------------
''' MIT License
'''
''' Copyright (c) 2012 Ion Cristian Buse
'''
''' Permission is hereby granted, free of charge, to any person obtaining a copy
''' of this software and associated documentation files (the "Software"), to
''' deal in the Software without restriction, including without limitation the
''' rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
''' sell copies of the Software, and to permit persons to whom the Software is
''' furnished to do so, subject to the following conditions:
'''
''' The above copyright notice and this permission notice shall be included in
''' all copies or substantial portions of the Software.
'''
''' THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
''' IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
''' FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
''' AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
''' LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
''' FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
''' IN THE SOFTWARE.
'''=============================================================================

'*******************************************************************************
'' Functions in this library module allow easy file system manipulation in VBA
'' regardless of:
''  - the host Application (Excel, Word, AutoCAD etc.)
''  - the operating system (Mac, Windows)
''  - application environment (x32, x64)
'' No extra library references are needed (e.g. Microsoft Scripting Runtime)
''
'' Public/Exposed methods:
''    - BrowseForFiles    (Windows only)
''    - BrowseForFolder   (Windows only)
''    - BuildPath
''    - CopyFile
''    - CopyFolder
''    - CreateFolder
''    - DeleteFile
''    - DeleteFolder
''    - FixFileName
''    - FixPathSeparators
''    - GetFileOwner      (Windows only)
''    - GetFiles
''    - GetFolders
''    - GetKnownFolderWin (Windows only)
''    - GetLocalPath
''    - GetRemotePath
''    - GetSpecialFolderMac (Mac only)
''    - IsFile
''    - IsFolder
''    - IsFolderEditable
''    - MoveFile
''    - MoveFolder
''    - ReadBytes
'*******************************************************************************

Option Explicit
Option Private Module

#Const Windows = (Mac = 0)

#If Mac Then
    #If VBA7 Then 'https://developer.apple.com/library/archive/documentation/System/Conceptual/ManPages_iPhoneOS/man3/iconv.3.html
        Private Declare PtrSafe Function iconv Lib "/usr/lib/libiconv.dylib" (ByVal cd As LongPtr, ByRef inBuf As LongPtr, ByRef inBytesLeft As LongPtr, ByRef outBuf As LongPtr, ByRef outBytesLeft As LongPtr) As LongPtr
        Private Declare PtrSafe Function iconv_open Lib "/usr/lib/libiconv.dylib" (ByVal toCode As LongPtr, ByVal fromCode As LongPtr) As LongPtr
        Private Declare PtrSafe Function iconv_close Lib "/usr/lib/libiconv.dylib" (ByVal cd As LongPtr) As Long
    #Else
        Private Declare Function iconv Lib "/usr/lib/libiconv.dylib" (ByVal cd As Long, ByRef inBuf As Long, ByRef inBytesLeft As Long, ByRef outBuf As Long, ByRef outBytesLeft As Long) As Long
        Private Declare Function iconv_open Lib "/usr/lib/libiconv.dylib" (ByVal toCode As Long, ByVal fromCode As Long) As Long
        Private Declare Function iconv_close Lib "/usr/lib/libiconv.dylib" (ByVal cd As Long) As Long
    #End If
#Else
    #If VBA7 Then
        Private Declare PtrSafe Function CopyFileA Lib "kernel32" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
        Private Declare PtrSafe Function DeleteFileA Lib "kernel32" (ByVal lpFileName As String) As Long
        Private Declare PtrSafe Function GetFileSecurity Lib "advapi32.dll" Alias "GetFileSecurityA" (ByVal lpFileName As String, ByVal RequestedInformation As Long, pSecurityDescriptor As Byte, ByVal nLength As Long, lpnLengthNeeded As Long) As Long
        Private Declare PtrSafe Function GetSecurityDescriptorOwner Lib "advapi32.dll" (pSecurityDescriptor As Byte, pOwner As LongPtr, lpbOwnerDefaulted As LongPtr) As Long
        Private Declare PtrSafe Function LookupAccountSid Lib "advapi32.dll" Alias "LookupAccountSidA" (ByVal lpSystemName As String, ByVal Sid As LongPtr, ByVal Name As String, cbName As Long, ByVal ReferencedDomainName As String, cbReferencedDomainName As Long, peUse As LongPtr) As Long
        Private Declare PtrSafe Function MultiByteToWideChar Lib "kernel32" (ByVal codePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As LongPtr, ByVal cbMultiByte As Long, ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As Long) As Long
        Private Declare PtrSafe Function WideCharToMultiByte Lib "kernel32" (ByVal codePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As Long, ByVal lpMultiByteStr As LongPtr, ByVal cbMultiByte As Long, ByVal lpDefaultChar As LongPtr, ByVal lpUsedDefaultChar As LongPtr) As Long
        Private Declare PtrSafe Function SHGetKnownFolderPath Lib "shell32" (ByRef rfid As GUID, ByVal dwFlags As Long, ByVal hToken As Long, ByRef pszPath As LongPtr) As Long
        Private Declare PtrSafe Function CLSIDFromString Lib "ole32" (ByVal lpszGuid As LongPtr, ByRef pGuid As GUID) As Long
        Private Declare PtrSafe Function lstrlenW Lib "kernel32" (ByVal lpString As LongPtr) As Long
        Private Declare PtrSafe Sub CoTaskMemFree Lib "ole32" (ByVal hMem As LongPtr)
        Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As LongPtr, ByVal Source As LongPtr, ByVal length As Long)
    #Else
        Private Declare Function CopyFileA Lib "kernel32" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
        Private Declare Function DeleteFileA Lib "kernel32" (ByVal lpFileName As String) As Long
        Private Declare Function GetFileSecurity Lib "advapi32.dll" Alias "GetFileSecurityA" (ByVal lpFileName As String, ByVal RequestedInformation As Long, pSecurityDescriptor As Byte, ByVal nLength As Long, lpnLengthNeeded As Long) As Long
        Private Declare Function GetSecurityDescriptorOwner Lib "advapi32.dll" (pSecurityDescriptor As Byte, pOwner As Long, lpbOwnerDefaulted As Long) As Long
        Private Declare Function LookupAccountSid Lib "advapi32.dll" Alias "LookupAccountSidA" (ByVal lpSystemName As String, ByVal Sid As Long, ByVal Name As String, cbName As Long, ByVal ReferencedDomainName As String, cbReferencedDomainName As Long, peUse As Long) As Long
        Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal codePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
        Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal codePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
        Private Declare Function SHGetKnownFolderPath Lib "shell32" (rfid As Any, ByVal dwFlags As Long, ByVal hToken As Long, ppszPath As Long) As Long
        Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpszGuid As Long, pGuid As Any) As Long
        Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
        Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal pv As Long)
        Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)
    #End If
#End If
' .... s Link

https://github.com/cristianbuse/VBA-File...eTools.bas

[Case]

Moin Candalfo,  

eventuell hilft das weiter:  

Eigenen Pfad auslesen bei OneDrive...