Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

OneDrive Datei mit PW per VBA öffnen klappt nicht?

OneDrive Datei mit PW per VBA öffnen klappt nicht?
15.10.2019 08:24:52
Norman
Guten Morgen,
Ich benutze unten anhängenden Code für einen Dateidialog (kann direkt in ein Modul kopiert werden).
Wenn ich dann Test() starte erscheint auch brav der File-Select-Dialog und macht das, was er soll.
ABER: Wenn ich eine OneDrive Excel-Datei auswähle, dann verändert er den Dateinamen. Beispiel:
Ich gebe folgendes ein
https://XXX-my.sharepoint.com/personal/vornane_nachname_XXX_onmicrosoft_com/Documents/Mappe1.xlsx
Hinweis: Ich kann auch "ganz normal" zu https://XXX-my.sharepoint.com/personal/vornane_nachname_XXX_onmicrosoft_com/Documents
browsen und dann auf die Datei doppelt klicken. Berechtigungen habe ich.
Aber der Rückgabewert, den ich aus der Funktion bekomme, ist nicht https://XXX...,
sondern:
\\XXX-my.sharepoint.com@SSL\DavWWWRoot\personal\vorname_nachname_XXX_onmicrosoft_com\Documents\Mappe1.xlsx
Hat jemand eine Ahnung, warum das so ist und ob ich das vermeiden kann? Mein Problem ist, dass der Zugriff mit dem, was der Dialog zurückliefert, nicht klappt, sehr wohl aber der Zugriff mit dem Original HTTPS://
Namen. Echt blöde.
Bin für Hilfe dankbar!
Viele Grüße
Norman
Option Explicit
' Shell File Operations
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Const FO_MOVE = &H1
Private Const FO_COPY = &H2
Private Const FO_DELETE = &H3
Private Const FO_RENAME = &H4
Private Const FOF_MULTIDESTFILES = &H1
Private Const FOF_CONFIRMMOUSE = &H2
Private Const FOF_SILENT = &H4 ' don't create progress/report
Private Const FOF_RENAMEONCOLLISION = &H8
Private Const FOF_NOCONFIRMATION = &H10 ' Don't prompt the user.
Private Const FOF_WANTMAPPINGHANDLE = &H20 ' Fill in SHFILEOPSTRUCT.hNameMappings
' Must be freed using SHFreeNameMappings
Private Const FOF_ALLOWUNDO = &H40
Private Const FOF_FILESONLY = &H80 ' on *.*, do only files
Private Const FOF_SIMPLEPROGRESS = &H100 ' means don't show names of files
Private Const FOF_NOCONFIRMMKDIR = &H200 ' don't confirm making any needed dirs
#If VBA7 And Win64 Then
' Done
Type SHFILEOPSTRUCT
hwnd As LongPtr
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAborted As Boolean
hNameMaps As LongPtr
sProgress As String
End Type
Declare PtrSafe

Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _
(lpFileOp As SHFILEOPSTRUCT) As LongPtr
#Else
Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAborted As Boolean
hNameMaps As Long
sProgress As String
End Type
Declare 

Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _
(lpFileOp As SHFILEOPSTRUCT) As Long
#End If
Const OFN_READONLY           As Long = &H1
Const OFN_EXPLORER           As Long = &H80000
Const OFN_LONGNAMES          As Long = &H200000
Const OFN_CREATEPROMPT       As Long = &H2000
Const OFN_NODEREFERENCELINKS As Long = &H100000
Const OFN_OVERWRITEPROMPT    As Long = &H2
Const OFN_HIDEREADONLY       As Long = &H4
Const OFN_NOCHANGEDIR        As Long = &H8
Const OFN_PATHMUSTEXIST      As Long = &H800
Const OFN_ENABLEHOOK As Long = &H20
Const OFN_ENABLESIZING As Long = &H800000
Public Const OFS_FILE_OPEN_FLAGS    As Long = OFN_EXPLORER _
Or OFN_LONGNAMES _
Or OFN_CREATEPROMPT _
Or OFN_NODEREFERENCELINKS _
Or OFN_NOCHANGEDIR
Public Const OFS_FILE_SAVE_FLAGS    As Long = OFN_EXPLORER _
Or OFN_LONGNAMES _
Or OFN_OVERWRITEPROMPT _
Or OFN_HIDEREADONLY
Public Const OFS_FILE_SAVE_FLAGS_NO_PROMPT    As Long = OFN_EXPLORER _
Or OFN_LONGNAMES _
Or OFN_HIDEREADONLY
Public Const WM_INITDIALOG As Long = &H110
Private Const SW_SHOWNORMAL As Long = 1
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const MAX_PATH = 260
#If VBA7 And Win64 Then
Public Declare PtrSafe 

Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public Type OPENFILENAME
lStructSize As Long
hwndOwner As LongPtr
hInstance As LongPtr
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex  As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle  As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As LongPtr
lpfnHook As LongPtr
lpTemplateName As String
End Type
' Done
Private Declare PtrSafe 

Function GetParent Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
' Private Declare PtrSafe 

Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As LongPtr, ByVal  _
lpString As String) As Long
' Private Declare PtrSafe 

Function MoveWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal x As Long, ByVal y As Long,  _
ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare PtrSafe 

Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
Declare PtrSafe 

Function GetSaveFileName Lib "comdlg32.dll" Alias _
"GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Declare PtrSafe 

Function GetShortPathName Lib "Kernel32.dll" Alias _
"GetShortPathNameA" (ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, _
ByVal cchBuffer As Long) As Long
Private Declare PtrSafe 

Sub CoTaskMemFree Lib "ole32.dll" _
(ByVal hMem As LongPtr)
Private Declare PtrSafe 

Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As  _
_
String) As LongPtr
Private Declare PtrSafe 

Function SHGetPathFromIDList Lib "shell32" _
(ByVal pidList As LongPtr, ByVal lpBuffer As String) As Long
Public Type BROWSEINFO
lngHWnd As LongPtr
pidlRoot As LongPtr
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As LongPtr
lParam As LongPtr
iImage As Long
End Type
Private Declare PtrSafe 

Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As Long
#Else
Public Declare 

Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex  As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle  As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Declare 

Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
' Private Declare 

Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString   _
_
As String) As Long
' Private Declare 

Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal   _
_
nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare 

Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Declare 

Function GetSaveFileName Lib "comdlg32.dll" Alias _
"GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Declare 

Function GetShortPathName Lib "Kernel32.dll" Alias _
"GetShortPathNameA" (ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, _
ByVal cchBuffer As Long) As Long
Private Declare 

Sub CoTaskMemFree Lib "ole32.dll" _
(ByVal hMem As Long)
Private Declare 

Function lstrcat Lib "kernel32" _
Alias "lstrcatA" (ByVal lpString1 As String, _
ByVal lpString2 As String) As Long
Private Declare 

Function SHGetPathFromIDList Lib "shell32" _
(ByVal pidList As Long, ByVal lpBuffer As String) As Long
Public Type BROWSEINFO
lngHWnd As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private Declare 

Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As Long
#End If

Sub Test()
Debug.Print EinfacheDateiauswahl
End Sub

'

Function EinfacheDateiauswahl(Optional flgs As Long = OFS_FILE_OPEN_FLAGS, Optional title As  _
String = "Bitte w?hlen Sie eine Datei aus:") As String

Function EinfacheDateiauswahl(Optional flgs As Long = OFS_FILE_OPEN_FLAGS, Optional title As  _
String = vbNullString) As String
If title = vbNullString Then
title = "Bitte w?hlen Sie eine Datei aus:"
End If
Dim OpenFile    As OPENFILENAME
Dim lReturn     As Long
'// Filter setzen und Index auf 2 (Datenbanken) setzen
'// Format: "Name" \n "Ext." \n "Name" \n "Ext." ... \n\n
Dim sFilter As String
sFilter = "Alle Dateien (*.*)" & vbNullChar & "*.*" & vbNullChar & "Textdateien (*.txt)" &   _
_
vbNullChar & "*.txt"
sFilter = sFilter & vbNullChar & vbNullChar
OpenFile.lpstrFilter = sFilter
OpenFile.nFilterIndex = 0
OpenFile.hwndOwner = 0
OpenFile.lpstrFile = String(257, 0)
#If VBA7 And Win64 Then
OpenFile.nMaxFile = LenB(OpenFile.lpstrFile) - 1
OpenFile.lStructSize = LenB(OpenFile)
#Else
OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
OpenFile.lStructSize = Len(OpenFile)
#End If
OpenFile.lpstrFileTitle = OpenFile.lpstrFile
OpenFile.nMaxFileTitle = OpenFile.nMaxFile
OpenFile.lpstrInitialDir = "C:\"
OpenFile.lpstrTitle = title
'    #If VBA7 And Win64 Then
OpenFile.flags = flgs Or OFN_ENABLESIZING
' XXX64
' OpenFile.lpfnHook = FARPROC(AddressOf OFNHookProc)
'    #Else
'      OpenFile.flags = flgs Or OFN_ENABLESIZING Or OFN_ENABLEHOOK
'      OpenFile.lpfnHook = FARPROC(AddressOf OFNHookProc)
'    #End If
'    uOFN.flags = flgs Or OFN_ENABLESIZING Or OFN_ENABLEHOOK
lReturn = GetOpenFileName(OpenFile)
If lReturn = 0 Then
EinfacheDateiauswahl = ""
Else
EinfacheDateiauswahl = Trim(Left(OpenFile.lpstrFile, InStr(1, OpenFile.lpstrFile,  _
vbNullChar) - 1))
End If
End Function

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: OneDrive Datei mit PW per VBA öffnen klappt nicht?
15.10.2019 09:10:30
Norman
Ahhhh, der hier liefert den korrekten Pfad:
Dim intChoice As Integer
Dim strPath As String
'only allow the user to select one file
xlapp.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
'make the file dialog visible to the user
intChoice = xlapp.FileDialog(msoFileDialogOpen).Show
'determine what choice the user made
If intChoice 0 Then
'get the file path selected by the user
Filename = xlapp.FileDialog( _
msoFileDialogOpen).SelectedItems(1)
End If
Anzeige

327 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige