Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1540to1544
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
Inhaltsverzeichnis

Änderung von Code

Änderung von Code
24.02.2017 15:39:24
Code
Hallo Ihr Excelspezialisten,
ich habe folgendes vor und suche seit Stunden.
Ich möchte von CD oder USB-Stick eine Verzeichnisstruktur in ein auszuwählendes
Verzeichnis einfügen.
Ich habe eine umgekehrte Version im Herber-Archiv gefunden. Hier wird von HDD Verzeichnis ausgewählt und in USB-Stick eingefügt.
Hallo Klaus
Teste mal das hier:
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************
Option Explicit
Dim arr
Dim L As Long
Public Sub Aufruf()
Dim objShell As Object
Dim objFolder As Object
Dim objItem As Object
L = 0
Redim arr(1)
Set objShell = CreateObject("Shell.Application")
With objShell
Set objFolder = .BrowseForFolder(0&, "Startordner suchen", 0)
End With
If Not objFolder Is Nothing Then
Set objItem = objFolder.Self
arr(L) = objItem.Path
arr(1) = "D:\Testordner"
L = 1
Else: Exit Sub
End If
Schreiben objItem.Path
verzeichnisse_erstellen (arr)
End Sub

Public Sub Schreiben(Suchordner)
Dim fso As Object
Dim datei
Dim Unterordner
Set fso = CreateObject("Scripting.FileSystemObject")
Set datei = fso.getfolder(Suchordner)
On Error Resume Next
For Each Unterordner In datei.subfolders
L = L + 1
Redim Preserve arr(L)
arr(L) = Replace(Unterordner.Path, arr(0), "D:\Testordner")
Schreiben Unterordner
Next
Set fso = Nothing
Set datei = Nothing
End Sub

Public Sub verzeichnisse_erstellen(a)
Dim LNG As Long
On Error Resume Next
For LNG = 1 To UBound(arr)
If Dir(arr(LNG)) = "" Then MkDir arr(LNG)
Next
End Sub

Nimm aber erstmal verzeichnisse in denen nichts steht.
ransi
Könnt Ihr mir helfen, dies umzubauen, dass ich von USB auf auszuwählende Verzeichnis einfügen kann.
Besten Dank für Eure Hilfe.
Gruss
Peter

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

Betreff
Datum
Anwender
Anzeige
AW: Änderung von Code
24.02.2017 16:07:16
Code
Hallo,
um einfach Verzeichnis-Strukturen, wahlweise mit oder ohne Datei, zu kopieren, ist XCOPY aus cmd.exe ("Eingabeaufforderung") recht gut geeignet.
mfg
AW: Änderung von Code
24.02.2017 17:36:41
Code
Hallo Fennek,
das ist nicht das was ich möchte.
Ich habe mir folgendes Makro erstellt:
Sub test_kopieren()
' Ordner kopieren
Dim FSO As New FileSystemObject
Dim Folder As Folder
Dim sFolderPath As String
Dim sDestPath As String
' Welcher Ordner soll kopiert werden?
'sFolderPath = "d:\temp\test\"
' Wohin soll der Ordner kopiert werden?
'sDestPath = "c:\test\"
' Kopiervorgang starten
Set Folder = FSO.GetFolder(sFolderPath)
Folder.Copy sDestPath
End Sub
Hier wird jedoch der Zielordner festgelegt.
Ich möchte jedoch den Zielordner aus dem Verzeichnis auswählen können - z. B. durch Set objFolder = .BrowseForFolder(0&, "Zieltordner suchen", 0).
Ich weiss aber nicht wie ich o.a. Makro hier einbinden kann.
Gruss
Peter
Anzeige
AW: Änderung von Code
25.02.2017 16:15:29
Code
Hallo Peter
probier es einmal mit dem unteren Code, indem du alles nach dem Speichern Dialog weg laesst.
Ich habe es nicht getestet, aber der Dialog fragt dich eindeutig wohin du speichern willst!!
Wenn es klappt Thread bitte schliessen, Kontroll Kastchen nicht mehr aktivieren!
mfg Piet

' Welcher Ordner soll kopiert werden?
'sFolderPath = "d:\temp\test\"
' Wohin soll der Ordner kopiert werden?
Application.GetSaveAsFilename
End sub

AW: Änderung von Code
25.02.2017 16:17:51
Code
Hallo Piet,
besten Dank für Deine Hilfe.
Zwischenzeitlich habe ich das Programm fertig.
Wünsche Dir noch ein schönes Wochenende.
Gruss
Peter
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige