Skopiuj plik z jednego folderu do drugiego za pomocą vbscripting

Question

Czy ktoś może mi powiedzieć, jak skopiować plik z jednego folderu do drugiego za pomocą vbscripting Próbowałem tego poniżej jeden z informacji w Internecie.

dim filesys 

set filesys=CreateObject("Scripting.FileSystemObject") 

If filesys.FileExists("c:\sourcefolder\anyfile.txt") Then 

filesys.CopyFile "c:\sourcefolder\anyfile.txt", "c:\destfolder\" 

Kiedy wykonuję ten, otrzymuję, że odmowa uprawnień.

Answer 1

Spróbuj tego. Sprawdza, czy plik już istnieje w folderze docelowym, a jeśli to zrobi, sprawdzi, czy plik jest tylko do odczytu. Jeśli plik jest tylko do odczytu, zmieni go na "odczyt-zapis", zastąp plik i ustaw go ponownie jako "tylko do odczytu".

Const DestinationFile = "c:\destfolder\anyfile.txt" 
Const SourceFile = "c:\sourcefolder\anyfile.txt" 

Set fso = CreateObject("Scripting.FileSystemObject") 
    'Check to see if the file already exists in the destination folder 
    If fso.FileExists(DestinationFile) Then 
     'Check to see if the file is read-only 
     If Not fso.GetFile(DestinationFile).Attributes And 1 Then 
      'The file exists and is not read-only. Safe to replace the file. 
      fso.CopyFile SourceFile, "C:\destfolder\", True 
     Else 
      'The file exists and is read-only. 
      'Remove the read-only attribute 
      fso.GetFile(DestinationFile).Attributes = fso.GetFile(DestinationFile).Attributes - 1 
      'Replace the file 
      fso.CopyFile SourceFile, "C:\destfolder\", True 
      'Reapply the read-only attribute 
      fso.GetFile(DestinationFile).Attributes = fso.GetFile(DestinationFile).Attributes + 1 
     End If 
    Else 
     'The file does not exist in the destination folder. Safe to copy file to this folder. 
     fso.CopyFile SourceFile, "C:\destfolder\", True 
    End If 
Set fso = Nothing 

Answer 2

Oto odpowiedź, na podstawie (i myślę, że poprawa na) odpowiedź Tester101, wyrażone jako podprogram, z linią CopyFile raz zamiast trzy razy, i przygotowany do obsługi zmiany nazwy pliku jako kopii jest tworzony (brak zakodowanego katalogu docelowego). Stwierdziłem również, że przed kopiowaniem muszę usunąć plik docelowy, aby to działało, ale może to być sprawa Windows 7. Wyrażenia WScript.Echo wynikają z tego, że nie miałem debuggera i można go oczywiście usunąć w razie potrzeby.

Sub CopyFile(SourceFile, DestinationFile) 

    Set fso = CreateObject("Scripting.FileSystemObject") 

    'Check to see if the file already exists in the destination folder 
    Dim wasReadOnly 
    wasReadOnly = False 
    If fso.FileExists(DestinationFile) Then 
     'Check to see if the file is read-only 
     If fso.GetFile(DestinationFile).Attributes And 1 Then 
      'The file exists and is read-only. 
      WScript.Echo "Removing the read-only attribute" 
      'Remove the read-only attribute 
      fso.GetFile(DestinationFile).Attributes = fso.GetFile(DestinationFile).Attributes - 1 
      wasReadOnly = True 
     End If 

     WScript.Echo "Deleting the file" 
     fso.DeleteFile DestinationFile, True 
    End If 

    'Copy the file 
    WScript.Echo "Copying " & SourceFile & " to " & DestinationFile 
    fso.CopyFile SourceFile, DestinationFile, True 

    If wasReadOnly Then 
     'Reapply the read-only attribute 
     fso.GetFile(DestinationFile).Attributes = fso.GetFile(DestinationFile).Attributes + 1 
    End If 

    Set fso = Nothing 

End Sub 

Answer 3

Właśnie napisałem mój gotowy kod dla podobnego projektu. Kopiuje pliki niektórych rozszerzeń w moim kodzie, a tif i tiff można zmienić na cokolwiek chcesz skopiować lub usunąć instrukcje if, jeśli potrzebujesz tylko 1 lub 2 typy. Kiedy plik jest tworzony lub modyfikowany, otrzymuje atrybut archiwum, ten kod również szuka tego atrybutu i kopiuje go tylko wtedy, gdy istnieje, a następnie usuwa go po skopiowaniu, aby nie kopiować niepotrzebnych plików. Ma również konfigurację dziennika, dzięki czemu zobaczysz dziennik o tym, o której godzinie i o dniu przeniesiono wszystko od ostatniego uruchomienia skryptu. Mam nadzieję, że to pomoże! link jest Error: Object Required; 'objDIR' Code: 800A01A8

Answer 4

do kopiowania pojedynczego pliku, oto kod:

Function CopyFiles(FiletoCopy,DestinationFolder) 
    Dim fso 
       Dim Filepath,WarFileLocation 
       Set fso = CreateObject("Scripting.FileSystemObject") 
       If Right(DestinationFolder,1) <>"\"Then 
        DestinationFolder=DestinationFolder&"\" 
       End If 
    fso.CopyFile FiletoCopy,DestinationFolder,True 
       FiletoCopy = Split(FiletoCopy,"\") 

End Function 

Answer 5

Proszę odnaleźć poniższy kod:

If ComboBox21.Value = "Delimited file" Then 
    'Const txtFldrPath As String = "C:\Users\513090.CTS\Desktop\MACRO"  'Change to folder path containing text files 
    Dim myValue2 As String 
    myValue2 = ComboBox22.Value 
    Dim txtFldrPath As Variant 
    txtFldrPath = InputBox("Give the file path") 
    'Dim CurrentFile As String: CurrentFile = Dir(txtFldrPath & "\" & "LL.txt") 
    Dim strLine() As String 
    Dim LineIndex As Long 
    Dim myValue As Variant 
    On Error GoTo Errhandler 
    myValue = InputBox("Give the DELIMITER") 

    Application.ScreenUpdating = False 
    Application.DisplayAlerts = False 
    While txtFldrPath <> vbNullString 
     LineIndex = 0 
     Close #1 
     'Open txtFldrPath & "\" & CurrentFile For Input As #1 
     Open txtFldrPath For Input As #1 
     While Not EOF(1) 
      LineIndex = LineIndex + 1 
      ReDim Preserve strLine(1 To LineIndex) 
      Line Input #1, strLine(LineIndex) 
     Wend 
     Close #1 

     With ActiveWorkbook.Sheets(myValue2).Range("A1").Resize(LineIndex, 1) 
      .Value = WorksheetFunction.Transpose(strLine) 
      .TextToColumns Other:=True, OtherChar:=myValue 
     End With 

     'ActiveSheet.UsedRange.EntireColumn.AutoFit 
     'ActiveSheet.Copy 
     'ActiveWorkbook.SaveAs xlsFldrPath & "\" & Replace(CurrentFile, ".txt", ".xls"), xlNormal 
     'ActiveWorkbook.Close False 
     ' ActiveSheet.UsedRange.ClearContents 

     CurrentFile = Dir 
    Wend 
    Application.DisplayAlerts = True 
    Application.ScreenUpdating = True 

End If