Copie un archivo de una carpeta a otra utilizando vbscripting

Question

¿Alguien puede decirme cómo copiar un archivo de una carpeta a otra usando vbscripting Lo he probado debajo de la información proporcionada en Internet.

dim filesys 

set filesys=CreateObject("Scripting.FileSystemObject") 

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

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

Cuando ejecuto este, obtengo que se deniega el permiso.

Answer 1

Pruebe esto. Verificará si el archivo ya existe en la carpeta de destino y, si lo hace, comprobará si el archivo es de solo lectura. Si el archivo es de solo lectura, lo cambiará a lectura-escritura, reemplazará el archivo y lo hará solo de nuevo.

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

Aquí es una respuesta, basado en (y creo que una mejora en) la respuesta de Tester101, expresado como una subrutina, con la línea de CopyFile vez en lugar de tres veces, y preparado para manejar el cambio de nombre de archivo que la copia está hecho (no hay un directorio de destino codificado). También encontré que tenía que eliminar el archivo de destino antes de copiar para que funcione, pero eso podría ser algo de Windows 7. Las instrucciones WScript.Echo se deben a que no tenía un depurador y, por supuesto, puedo eliminarlo si lo desea.

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

Acabo de publicar mi código final para un proyecto similar. Copia archivos de ciertas extensiones en mi código, su pdf tif y tiff. Puede cambiarlos a lo que quiera copiar o eliminar los enunciados if si solo necesita 1 o 2 tipos. Cuando se crea o modifica un archivo, se obtiene el atributo de archivo; este código también busca ese atributo y solo lo copia si existe y luego lo elimina después de copiarlo para que no copie los archivos innecesarios. También tiene una configuración de registro para que pueda ver un registro de la hora y el día en que todo se transfirió desde la última vez que ejecutó el script. ¡Espero eso ayude! el enlace es Error: Object Required; 'objDIR' Code: 800A01A8

Answer 4

Para copiar el archivo único, aquí está el código:

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

Por favor, encontrar el código de abajo:

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