Sub TabellezuCad()
'am 20.02.2007 überarbeitet
Dim smsg As String, spath As String
Dim iCol As Integer, iRow As Long, strTmp As String
If Worksheet_suchen("cad") = True Then
Worksheets("cad").Select
smsg = "Wo soll die Datei abgelegt werden ?"
spath = ordner(smsg)
If spath <> "" Then strTempFolder = spath
'usw
Sub end
Private Type BROWSEINFO
hOwner 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
Declare
Function SHGetpathfromidlist Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszpath As String) As Long
Declare
Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Function ordner(Optional smsg) As String
Dim lpBrowseInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
lpBrowseInfo.pidlRoot = 0&
If IsMissing(smsg) Then
lpBrowseInfo.lpszTitle = "Wählen sie bitte einen Ordner aus."
Else
lpBrowseInfo.lpszTitle = smsg
End If
lpBrowseInfo.ulFlags = &H1
x = SHBrowseForFolder(lpBrowseInfo)
path = Space$(512)
r = SHGetpathfromidlist(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
ordner = Left(path, pos - 1)
Else
ordner = ""
End If
End Function
danke!
gruß
swen