vbscriptingを使用してあるフォルダから別のフォルダにファイルをコピーする

Question

誰でも、あるフォルダから別のフォルダにファイルをコピーする方法を教えてください。 インターネットで提供されている情報からこれを試しました。

dim filesys 

set filesys=CreateObject("Scripting.FileSystemObject") 

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

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

このファイルを実行すると、アクセス許可が拒否されます。

Answer 1

これを試してください。ファイルが既に宛先フォルダに存在するかどうかを確認し、そうであれば、ファイルが読み取り専用かどうかをチェックします。ファイルが読み取り専用の場合は、読み取り/書き込み可能に変更し、ファイルを置き換えて、読み取り専用にします。

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

ここでのCopyFileラインに一度の代わりに3回、サブルーチンとして表現に基づいて回答、（と私は上の改善を考える）Tester101の答えは、だし、コピーなどのファイル名を変更し処理する準備（ハードコードされた宛先ディレクトリはありません）。また、コピーする前にコピー先のファイルを削除しなければならないこともわかりましたが、それはWindows 7の問題かもしれません。 WScript.Echoステートメントは、私がデバッガを持っていなかったので、もちろん望むなら削除することができます。

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

似たようなプロジェクトの完成コードを投稿しました。私のコードで特定の拡張子のファイルをpdf tifとtiffにコピーします。あなたがコピーしたいものに変更するか、1つまたは2つのタイプしか必要ない場合はifステートメントを削除できます。ファイルが作成または変更されると、アーカイブ属性が取得されます。このコードはその属性も検索し、存在する場合のみコピーし、コピー後に削除して不要なファイルをコピーしません。また、スクリプトを実行した最後の時刻からevetrythingが転送された日時のログが表示されます。それが役に立てば幸い！ リンクは1つのファイルをコピーするためのError: Object Required; 'objDIR' Code: 800A01A8

Answer 4

あり、ここでのコードは次のとおりです。

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

以下のコード見つけてください：

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