OneDrive Datei mit PW per VBA öffnen klappt nicht?
15.10.2019 08:24:52
Norman
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