öffnen, aktualisieren, speichen, schließen
01.04.2008 21:12:00
wossi
folgendes möchte ich bewirken. bei click auf einen Button, soll sich ein Fenster(Verzeichnisbaum) öffnen, ich wähle mir ein Verzeichnis aus, und nun sollen alle Dateien darin nacheinander geöffnet, verknüpfungen etc. aktualisiert werden, speichern und wieder schließen.
Habe in dem FAQ hier auch was gefunden, weiß nur nicht wie ich s zusammenbringe....
Verzeichnis auswählen:
StandardModule: basMain
Option Private Module
Public 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
Sub DirAuswahl()
Dim sMsg As String, sPath As String
sMsg = "Wählen Sie bitte einen Ordner aus:"
sPath = getdirectory(sMsg)
If sPath "" Then MsgBox sPath
End Sub
Function getdirectory(Optional msg) As String
Dim bInfo As BROWSEINFO
Dim Path As String
Dim r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(msg) Then
bInfo.lpszTitle = "Wählen Sie bitte einen Ordner aus."
Else
bInfo.lpszTitle = msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
Path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal Path)
If r Then
pos = InStr(Path, Chr$(0))
getdirectory = Left(Path, pos - 1)
Else
getdirectory = ""
End If
End Function
öfnnen, aktualissieren, speichern, schließen:
StandardModule: Modul1
Sub OeffnenSchliessen()
Dim iRow As Integer
Dim sFile As String
On Error GoTo ERRORHANDLER
Application.ScreenUpdating = False
Application.EnableEvents = False
iRow = 1
Do Until IsEmpty(Cells(iRow, 1))
sFile = Cells(iRow, 1).Value
If Dir(sFile) "" Then
Workbooks.Open _
Filename:=sFile, _
updatelinks:=True
ActiveWorkbook.Close savechanges:=True
End If
iRow = iRow + 1
Loop
ERRORHANDLER:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Kann mir jemand helfen, das so zusammen zubringen, dass es nach meinen Vorstellungen funktioniert?
Besten Dank.
Gruß
wossi