42

ボタンをクリックすると、すべてを新しいワークブックにコピー/貼り付けることで複製し、いくつかの変数値(スプレッドシートのセルから取得)に依存する名前でファイルを保存するスプレッドシートがあります。私の現在の目標は、クライアント名(変数に保持されているセル値)の名前に応じてシートを異なるフォルダーに保存することですが、これは最初の実行で機能しますが、後でエラーが発生します。

このコードは、ディレクトリが存在するかどうかを確認し、存在しない場合は作成します。これは機能しますが、作成後にもう一度実行するとエラーがスローされます。

ランタイム エラー 75 - パス/ファイル アクセス エラー。

私のコード:

Sub Pastefile()

Dim client As String
Dim site As String
Dim screeningdate As Date
screeningdate = Range("b7").Value
Dim screeningdate_text As String
screeningdate_text = Format$(screeningdate, "yyyy\-mm\-dd")
client = Range("B3").Value
site = Range("B23").Value

Dim SrceFile
Dim DestFile

If Dir("C:\2013 Recieved Schedules" & "\" & client) = Empty Then
    MkDir "C:\2013 Recieved Schedules" & "\" & client
End If

SrceFile = "C:\2013 Recieved Schedules\schedule template.xlsx"
DestFile = "C:\2013 Recieved Schedules\" & client & "\" & client & " " & site & " " & screeningdate_text & ".xlsx"

FileCopy SrceFile, DestFile

Range("A1:I37").Select
Selection.Copy
Workbooks.Open Filename:= _
    "C:\2013 Recieved Schedules\" & client & "\" & client & " " & site & " " & screeningdate_text & ".xlsx", UpdateLinks:= _
    0
Range("A1:I37").PasteSpecial Paste:=xlPasteValues
Range("C6").Select
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWindow.Close

End Sub

この分野の知識が不足していることをお許しください。私はまだ学んでいます。MkDirエラーがスローされると行が強調表示されるため、ディレクトリチェックロジックと関係があると非常に強く感じています。

4

7 に答える 7

111

を使用してディレクトリの存在を確認するには、次のように 2 番目の引数としてDir指定する必要があります。vbDirectory

If Dir("C:\2013 Recieved Schedules" & "\" & client, vbDirectory) = "" Then

vbDirectorywithでは、指定されたパスがディレクトリまたはファイルとしてDir既に存在する場合、空でない文字列が返されることに注意してください(ファイルに読み取り専用、非表示、またはシステム属性がない場合)。ファイルではなくディレクトリであることを確認するために使用できます。GetAttr

于 2013-03-18T16:35:24.133 に答える
34

FolderExistsオブジェクトのメソッドを使用しScriptingます。

Public Function dirExists(s_directory As String) As Boolean
    Dim oFSO As Object
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    dirExists = oFSO.FolderExists(s_directory)
End Function
于 2017-01-02T23:34:12.940 に答える
4
If Len(Dir(ThisWorkbook.Path & "\YOUR_DIRECTORY", vbDirectory)) = 0 Then
   MkDir ThisWorkbook.Path & "\YOUR_DIRECTORY"
End If
于 2014-02-19T17:31:18.767 に答える