Anzeige
Archiv - Navigation
336to340
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
336to340
336to340
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Ordner umbenennen

Ordner umbenennen
15.11.2003 15:26:54
Carsten
Hallo,

ich habe folgendes vor:
Per Scanner will ich Dokumente archivieren. Beim scannen wird aber das Dokument nicht so abgelegt wie ich es gerne möchte (läßt sich auch definitiv nicht ändern). Der Scanner erzeugt immer einen Ordner mit einem von mir vorgegebenen Namen. In diesem Ordner liegt ein Unterordner und in diesem liegt erst mein gescanntes Dokument.
Beispiel:

123 (Ordnername von mir vergeben)
|
0000000x.00000000 (Ordnername wird automatisch angelegt)
|
1.pg (Dateiname des gescannten Dokuments)

hier nochmal der Pfad in anderer Schreibweise
c:\123\0000000x.00000000\1.pg

Jetzt meine eigentliche Frage: Kann ich per Vba irgendwie eine Struktur einlesen und immer den Ordnernamen aus einer best. Ebene (hier 123) der Datei 1.pg zuweisen. Diese Datei will ich dann abspeichern (c:\123.pg).

Ich hab schon versucht das Problem üder diverse Programme (Stapelverarbeitungen etc.) zu lösen, aber es funktioniert so nicht.

Ihr im Excel-Forum seid meine letzte Hoffnung...

Gruß

Carsten

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Ordner umbenennen
15.11.2003 15:52:16
Nepumuk
Hallo Carsten,

nicht unbedingt ein Problem für VBA, wenn es damit natürlich auch geht. Hast du VB?

Wie hast du dir den Programmablauf vorgestellt? Beispiel: Programm öffnen, über ein Browserfenster den Ordner auswählen, fertig. Das Programm prüft, ob im Ordner ein pg-Datei vorhanden und wenn es genau eine pg-Datei ist, dann umbenennen, kopieren, Ordner löschen und Meldung ausgeben, dass der Job erledigt wurde, ansonsten Fehlermeldung.

Gruß
Nepumuk
AW: Ordner umbenennen
15.11.2003 16:40:43
Carsten
Hallo Nepumuk,

ich habe kein VB, würde gerne über VBA das Problem lösen. Ich dachte mir folgendes: Programm öffnen, Hauptordner aussuchen (z.B. c:\Scanner). Das Programm prüft, ob es es im Ordner z. B. c:\Scanner Unterordner gibt. Wenn ja, dann 1. Unterordner z.B 1234 merken, in Unterordner 0000000x.00000000 gehen und dort die Datei 1.pg in 1234.pg umbenennen. Danach die umbenannte Datei in die Ebene c:\Scanner\ legen und den Ordner 1234 inkl. aller Unterordner löschen. Danach prüfen, ob weiterer Unterordner in c:\scanner\ vorhanden ist. Wenn ja, dann selbe Prozedur wie eben, ansonsten Meldung.
Ich hab leider 0 Ahnung, wie man sowas programmiert.

Gruß Carsten
Anzeige
AW: Ordner umbenennen
15.11.2003 21:18:40
Nepumuk
Hallo Carsten,
versuch es mal damit:


Option Explicit
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As InfoT) As Long
Private Declare Function CoTaskMemFree Lib "ole32" (ByVal hMem As Long) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpStr1 As String, ByVal lpStr2 As String) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pList As Long, ByVal lpBuffer As String) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassname As String, ByVal lpWindowName As String) As Long
Private Type InfoT
hwnd As Long
Root As Long
DisplayName As Long
Title As Long
Flags As Long
FName As Long
lParam As Long
Image As Long
End Type
Private Function GetAOrdner() As String
Dim xl As InfoT, IDList As Long, RVal As Long, FolderName As String
With xl
.hwnd = FindWindow("xlmain", vbNullString)
.Title = lstrcat("Bitte wählen Sie ein Verzeichnis", "")
.Flags = 1
End With
IDList = SHBrowseForFolder(xl)
If IDList <> 0 Then
FolderName = Space(256)
RVal = SHGetPathFromIDList(IDList, FolderName)
CoTaskMemFree (IDList)
FolderName = Trim(FolderName)
FolderName = Left(FolderName, Len(FolderName) - 1)
End If
GetAOrdner = FolderName
End Function
Public Sub Dateien_suchen()
Dim strOrdner As String, myFileObjekt As Object, intCont As Integer
Dim myFSyObjekt As Object, myFoObjekt As Object, mySFoObjekt As Object, myFolderObjekt As Object
strOrdner = GetAOrdner
If strOrdner <> "" Then
Set myFSyObjekt = CreateObject("Scripting.FileSystemObject")
Set myFoObjekt = myFSyObjekt.GetFolder(strOrdner)
Set mySFoObjekt = myFoObjekt.SubFolders
For Each myFolderObjekt In mySFoObjekt
With Application.FileSearch
.LookIn = strOrdner & "\" & myFolderObjekt.Name
.Filename = "*.pg"
.SearchSubFolders = True
If .Execute = 1 Then
Set myFileObjekt = myFSyObjekt.GetFile(.FoundFiles(1))
myFileObjekt.Name = myFolderObjekt.Name & ".pg"
myFileObjekt.Move strOrdner & "\"
myFolderObjekt.Delete True
intCont = intCont + 1
End If
End With
Next
MsgBox "Fertig. " & CStr(intCont) & " Dateien umbenannt und verschoben.", 64, "Information"
End If
End Sub



Code eingefügt mit: Excel Code Jeanie

Gruß
Nepumuk
Anzeige
AW: Genial Nepumuk, Danke
15.11.2003 23:40:15
Carsten
Hallo Nepumuk,

G E N I A L !!!

Deine VBA-Lösung ist super. Genau so hab ich mir das vorgestellt.
Hätte nie so schnell mit einer Lösung gerechnet.
Du bist ein echtes Ass. Vielen Dank für Deine Hilfe.

Gruß

Carsten

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige