web-dev-qa-db-ja.com

Excel VBAディレクトリが存在するかどうかを確認するエラー

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

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

ランタイムエラー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行が強調表示されるので、ディレクトリチェックロジックと関係があると非常に強く感じています。

excelvbafiledirectory
36
user1571463

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

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

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

98
Brian Camire

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

Public Function dirExists(s_directory As String) As Boolean

Set OFSO = CreateObject("Scripting.FileSystemObject")
dirExists = OFSO.FolderExists(s_directory)

End Function
22
ozmike

folderが存在することを確認するために（fileではなく）この関数を使用します：

Public Function FolderExists(strFolderPath As String) As Boolean
    On Error Resume Next
    FolderExists = ((GetAttr(strFolderPath) And vbDirectory) = vbDirectory)
    On Error GoTo 0
End Function

\が最後にある場合とない場合の両方で機能します。

5
ZygD

私は最終的に使用しました：

Function DirectoryExists(Directory As String) As Boolean
    DirectoryExists = False
    If Len(Dir(Directory, vbDirectory)) > 0 Then
        If (GetAttr(Directory) And vbDirectory) = vbDirectory Then
            DirectoryExists = True
        End If
    End If
End Function

@Brianと@ZygDの回答が混在しています。 @Brianの答えでは不十分で、@ ZygDの答えで使用されるOn Error Resume Nextが気に入らないと思う場所

4
TGN12
If Len(Dir(ThisWorkbook.Path & "\YOUR_DIRECTORY", vbDirectory)) = 0 Then
   MkDir ThisWorkbook.Path & "\YOUR_DIRECTORY"
End If
4
EGOBLIN