Dateien kopieren
05.04.2005 12:50:26
Rene
Ich muß leider schon wieder nerven. Habe diesen Code:
Option Explicit
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const MAX_PATH As Long = 260
Function BrowseFolder(Optional Caption As String, _
Optional InitialFolder As String) As String
Dim Sh As shell32.Shell
Dim F As shell32.Folder
Set Sh = New shell32.Shell
Set F = Sh.BrowseForFolder(0&, Caption, BIF_RETURNONLYFSDIRS, _
InitialFolder)
If Not F Is Nothing Then
BrowseFolder = F.Items.Item.Path
End If
End Function
Sub Xls_und_RCA_Dateien_kopieren()
'On Error Resume Next
Dim objFSO As Object
Dim fSearch As FileSearch
Dim srcPath As String, tarpath As String, srcFile As String, tarFile As String
Dim fCount As Integer
srcPath = BrowseFolder("Order wählen", "C:\Test\Test1\RCA\") 'Quellverzeichnis
tarpath = "C:\Test\" 'Zielverzeichnis
If srcPath = "" Then Exit Sub
Set fSearch = Application.FileSearch
With fSearch
'ermitteln der Anzahl von *.xls - Files im Quellverzeichnis
.NewSearch
.LookIn = srcPath
.SearchSubFolders = False '<<<<Unterordner durchsuchen True/False
.FileType = msoFileTypeAllFiles
.Filename = "*.xls"
.Execute
'ermitteln der Anzahl von *.mem - Files im Quellverzeichnis
.NewSearch
.LookIn = srcPath
.SearchSubFolders = False '<<<<Unterordner durchsuchen True/False
.FileType = msoFileTypeAllFiles
.Filename = "*.mem"
.Execute
Set objFSO = CreateObject("Scripting.FileSystemObject")
For fCount = 1 To .FoundFiles.Count
If Right(.FoundFiles(fCount), 3) = "mem" Then
'mem-File kopieren und umbenennen
srcFile = .FoundFiles(fCount)
tarFile = tarpath & "\RCA" & ".mem"
objFSO.CopyFile srcFile, tarFile
ElseIf Right(.FoundFiles(fCount), 2) = "xls" Then
'xls-File kopieren und umbenennen
srcFile = .FoundFiles(fCount)
tarFile = tarpath & "\Liste1" & ".xls"
objFSO.CopyFile srcFile, tarFile
Workbooks.Open Filename:="C:\Test\Liste1.xls"
Application.ScreenUpdating = False
Range("A1:I87").Select
Selection.Copy
Windows("Liste.xls").Activate
Range("A1:I87").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Windows("Liste1.xls").Activate
ActiveWindow.Close SaveChanges:=False
Range("A1").Select
Application.ScreenUpdating = True
kill ("C:\Test\Liste1.xls")
End If
Next
End With
Set objFSO = Nothing
Set fSearch = Nothing
End Sub
Wenn ich ihn so ausführe kopiert er mir nur die RCA Datei und macht bei der xls Datei gar nichts. Wenn ich nun aber das Macro so schreibe das er nur die xls Datei kopieren soll geht es. Nur eben beide zusammen gehen nicht.Ich brauch aber beide Dateien. Kann mir dabei einer mal bitte helfen was hier falsch ist?
Danke im Vorraus
Rene