フォルダ存在確認でメッセージが表示されない問題の解決方法

このQ&Aのポイント
  • 実際に存在するはずのフォルダに対してフォルダの存在確認を行い、メッセージが表示されない問題が発生しています。
  • 条件文のTrueをFalseにするとメッセージが表示されるが、フォルダ名が表示される問題も発生しています。
  • 問題の原因は、DirPathad変数に日付を代入する際に不適切な形式(YYYYMMDDではない)で代入しているためだと考えられます。
回答を見る
  • ベストアンサー

フォルダの中に本日付けのフォルダが存在するか確認し、

フォルダの中に本日付けのフォルダが存在するか確認し、 存在した場合メッセージをだしたいのですが、実際存在するのに もかかわらずメッセージが表示されません。 ちなみにシートのD1にDATE関数が入っています。 If (fFso.FolderExists(DirPathad) = True)のTrueをFalseにすると メッセージが表示されます。 ・・ですが実行させてDirPathadにカーソルをもってくると2010612のように フォルダ名が表示されます。 何がおかしいのでしょうか? Dim fFso As Object Dim DirPathad As String DirPathad = Year(Range("D1")) & Month(Range("D1")) & Day(Range("D1")) Set fFso = CreateObject("Scripting.FileSystemObject") If (fFso.FolderExists(DirPathad) = True) Then MsgBox "本日付けのフォルダが存在します。" Set fFso = Nothing      End IF

質問者が選んだベストアンサー

  • ベストアンサー
  • kmetu
  • ベストアンサー率41% (562/1346)
回答No.2

カレントフォルダにそのフォルダが存在するでしょうか カレントフォルダでないのでしたら ChDrive "d" ChDir "\" と言った感じでカレントフォルダを移動するか DirPathad = "d:\" & Year(Range("D1")) & Month(Range("D1")) & Day(Range("D1")) と言った感じでフルパス指定しましょう。 また、フォルダ名は 2010612 なんですよね 20100612 とかになっていませんか。

maki06
質問者

お礼

kmetuさん、ちゃんとフルパスを 指定したらメッセージが表示されました! ありがとうございました!

その他の回答 (1)

  • muunoy
  • ベストアンサー率38% (70/183)
回答No.1

パス指定がフォルダのみなので、カレントディレクトリに見にいっているのでは? カレントディレクトリにはありますか?

maki06
質問者

お礼

muunoyさん、仰る通りでした。 パスまで指定したらちゃんとメッセージが表示されるように なりまました。 ありがとうございます!

関連するQ&A

  • ディレクトリの存在有無の確認方法

    VB6を使っています。 ファイルの存在有無はFileSystemObjectを使って以下のような方法で確認しいますが、ディレクトリの存在有無はどのようにすれば、確かめられるでしょうか? Dim objFileSys As Object Set objFileSys = CreateObject("Scripting.FileSystemObject") If objFileSys.FileExists("C:ABC.XYZ") Then よろしくお願いします。

  • (VBA) 同名フォルダーの存在をチェック

    以下のコード(Sub ⑤フォルダー名の変更())でフォルダー名の変更を行っています。 変名時に同名ファイルがある場合エラーが以下のコードでエラーがでます。   .GetFolder(Range("A2").Text & Range("B" & i).Text).Name = Cells(i, LastColumn).Text エラー無く処理したいので  同名があるばあいは、フォルダー名の末尾に(1)、(2)を付加したいのですが  同名があるかどうかは?どのように判定しますか ? Sub ⑤フォルダー名の変更() Dim i As Long Dim LastColumn As Single Dim LastColumn_ABC As String Dim MSG As String LastColumn = Cells(5, "B").End(xlToRight).Column LastColumn_ABC = Split(Cells(1, LastColumn).Address, "$")(1) MSG = MsgBox("B列フォルダー名が" & LastColumn_ABC & "列フォルダー名に変更されます!" & vbCrLf _ & "B," & LastColumn_ABC & "列に値がなければ、処理は行いません。", 257, "フォルダー名変更") If MSG = vbCancel Then Exit Sub i = 5 'subフォルダ名取得が5行目からフォルダー名を表示するため。 Do While Range("b" & i).Text <> "" If Cells(i, LastColumn).Text <> "" Then ' 新フォルダー名がある場合のみ、名前変更を行う。 With CreateObject("Scripting.FileSystemObject") .GetFolder(Range("A2").Text & Range("B" & i).Text).Name = Cells(i, LastColumn).Text End With End If i = i + 1 Loop MsgBox "変名処理が終了しました。" End Sub

  • フォルダをコピー フォルダの中に入れたい FSO

    vbaです。よろしくお願いします。 Sub Sample() Dim myFSO As Object Dim MyPath As String MyPath = "C:\Users\ああああ\Desktop\" Set myFSO = CreateObject("Scripting.FileSystemObject") myFSO.CopyFolder MyPath & "コピーしたフォルダーを入れるフォルダー", MyPath & "コピーするフォルダ" Set myFSO = Nothing End Sub こんな感じで、デスクトップにある、"コピーするフォルダ"をコピーして、 デスクトップにある、"コピーしたフォルダーを入れるフォルダー"の中に入れたいのですが 上記のコードを実行しても何も起きません。 コピーしたフォルダーを入れるフォルダーの中身を見ても、空です。 ”コピーしたフォルダーを入れるフォルダー”の中に、"コピーするフォルダ" を入れる方法を教えてください。

  • 再帰処理でアクセス禁止フォルダが存在した際の対応

    こんにちは。 ファイルの一覧を表示するモジュールを作成しました。 その際、アクセスが禁止されるフォルダ(何かのきっかけで 作成されたフォルダ。削除できません。)があった場合、 For Each subfolder In folder.SubFoldersの行で、 「書き込みできません」で停止してしまいます。 このフォルダを削除しないで(存在させたままで)処理を継続 することは可能でしょうか? よろしくご教授願います。 Dim fso As Object Dim folder As Object Dim subfolder As Object Dim file As Object Set fso = CreateObject("Scripting.FileSystemObject") Set folder = fso.GetFolder(strTargetDir) For Each subfolder In folder.SubFolders FolderSearch subfolder.Path Next subfolder For Each file In folder.Files With file Debug.Print .Path End With Next file

  • Access VBA で フォルダ権限をチェックする

    フォルダの有無を以下のようにチェックして フォルダがあった場合はフォルダの権限をチェックしてそのフォルダ内にmdbを作成するという事を行いたいのですが、 フォルダのアクセス権限かあるかどうかのチェックの仕方がわかりません。 Dim ExtDirName1 AS String ExtDirName1 = "C:\TEMP If (objFileSys.FolderExists(ExtDirName1) = True) Then   'ここでフォルダのアクセス権限をチェック 'フォルダがあった場合はこのフォルダにmdbを作成 End IF よろしくお願いします。

  • VBSを使ってフォルダを圧縮

    初めましてsazzzzと申します。 恥を承知、お解りになる方に聞いてみようかとこの度投稿した次第です。 どなたか助けてください。宜しくお願いします。VBSめちゃめちゃ初心者なのです。 ☆不特定なファイルが格納されているフォルダを指定フォルダに圧縮 ☆VBSを使い、業務時間外にタスクで管理したい ☆Windows2000(いまだに...)を使用 不作VBSを書かせて頂きます。ファイルでは、動作問題なく出来ましたが、フォルダとなると無理でした。 '---------------フォルダーのコピー-------------------- 'コピーフォルダ名 strFolder= "TEST" '圧縮フォルダ名 strZipFolder= strFolder & ".zip" MsgBox strZipFolder 'コピー元パス strSource="\\Pink\Work\" & strFolder 'コピー先パス strDestinate="\\Pink\Work\BK\" Set objFS = CreateObject("Scripting.FileSystemObject") Set objFB = CreateObject("Scripting.FileSystemObject") If objFS.FolderExists(strSource) = False Then objFB.CreateFolder(strSource) End If objFB.CopyFolder strSource , strDestinate , False '--------------コピー元フォルダの削除----------------------- strPath = strSource Set objFS = CreateObject("Scripting.FileSystemObject") If objFS.FolderExists(strPath) = False Then MsgBox("指定されたフォルダが存在しません。") Else objFB.DeleteFolder strPath End If 'DOSコマンドを実行して、圧縮する  Set ws = WScript.CreateObject("WScript.Shell") strDC="Makecab " & strDestinate & strFolder & " " & strDestinate & strZipFolder ws.Run strDC,0,true set ws=nothing objFS.DeleteFile(strDestinate & strFolder) Set objFS=Nothing Set objFB=Nothing

  • 特定の名前のシートがあるか確認するには

    1つのフォルダの中に 4つのエクセルファイルがあります。 そのエクセルファイルの中に12というファイル名がある場合は メッセージを出したいと考えて以下のコードを書きました。 この4つのファイルのうち1つのファイルに12のシートを 存在させてみて、以下のコードで実行しました。 Sub シートの確認2() Const MyPath As String = "C:\test\" Dim MyBook As Workbook Dim MyFileName As String Dim MyRng As Range Dim i As Long Dim ws As Worksheet, flag As Boolean MyFileName = Dir(MyPath & "*.xlsx") Do While MyFileName <> "" If ThisWorkbook.Name <> MyFileName Then Set MyBook = Workbooks.Open(MyPath & MyFileName) For i = 1 To Worksheets.Count If Worksheets(i).Name <> "12" Then MsgBox "[12]シートが存在しません。" Else MsgBox "[12]シートが存在します。" End If Next i MyBook.Close End If MyFileName = Dir() Loop End Sub すると、 12という名前のあるシートを持つブックの場合、 "[12]シートが存在しません。" "[12]シートが存在します。" の両方のメッセージが出てきます。 おそらく考えるに そのブックにはシートが2枚あり、 そのうち1つが12という名前のシートであり もう一つは違う名前なので このような現象が出てくるのではないかと。 ただ単純に、その同一フォルダ内のブックに12というがあるかないかを 取得するにはどうしたらよいでしょうか?

  • フォルダー名に特殊文字?が存在する場合にエラー発生

    以下のコードでフォルダー名を取得しています。 しかし、フォルダー名に特殊文字?が存在する場合に下記でエラーが発生します。  例えば「Oxygène」 でeの上に’があるなど   If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then      実行エラー 53: ファイルが見つかりません。 これは、excelの仕様で処理できないのでしょうか ? 他のコードで処理できれば教えて下さい。 --------------------------------------- Sub フォルダ名取得() Dim MyName Dim MyPath Dim i As Long ’仮の消込(初期化: 前回の記入文をクリアー) Range("A5:H50").Clear i = 1 ' フォルダーを自由に選べること。 参考:officeTANAKA With Application.FileDialog(msoFileDialogFolderPicker) If .Show = True Then ' MsgBox .SelectedItems(1) If Len(.SelectedItems(1)) = 3 Then ' c:\の場合とサブフォルダーの場合 MyPath = .SelectedItems(1) Else MyPath = .SelectedItems(1) & "\" End If End If End With If MyPath = Empty Then MsgBox "フォルダー名表示をキャンセルしました。": Exit Sub 'Range("b2:c2").ShrinkToFit = True ' 縮小してセル内に表示 MyName = Dir(MyPath, vbDirectory) ' 最初のフォルダ名を返します。 '親フォルダー Range("A2") = MyPath Do While MyName <> "" ' ループを開始します。 ' 現在のフォルダと親フォルダは無視します。 If MyName <> "." And MyName <> ".." Then ' ビット単位の比較を行い、MyName がフォルダかどうかを調べます。 If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then Range("a" & i + 4) = MyPath & MyName ' アクティブシートA5セルから下方にフルパス表示。 Range("b" & i + 4) = MyName ' アクティブシートB5セルから下方にフォルダ名表示 i = i + 1 End If End If MyName = Dir ' 次のフォルダ名を返します。 Loop MsgBox MyPath & "の中にフォルダーは" & (i - 1) & "個のフォルダーがありました。" End Sub

  • マクロで特定のフォルダの中から任意のフォルダを開きたい

    マクロで特定のフォルダの中から、任意のフォルダを開きたいのです。 または、特定のフォルダの中から最新のブックを開きたいのですが このような方法ご存知の方ご教示いただけませんでしょうか^^; 以下のコードは、似たような方法がないか検索して 見つけたマクロなのですが、この方法ですと 特定のフォルダを指定して開くことはできますが 任意のフォルダを一発で開くということは難しいようです。 Private Sub Worksheet_BeforeDoubleClick() Cancel = True Const dataDir As String = "C:\テスト\保存データ\" Dim dataFilePath As String dataFilePath = dataDir & Target.Value & ".xls" Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") If fso.FileExists(dataFilePath) Then Workbooks.Open (dataFilePath) End If 保存データというフォルダに番号がフォルダ名のフォルダが複数入っています。 例) 100 101 102 103 104 と、いった具合です。 保存フォルダの中の104(任意のフォルダ)を開くマクロまたは番号のフォルダは関係なく 保存フォルダの中の最新ブックを開くことができるような方法はないでしょうか? 開きたいブックというのは、最新ブックのみですので、この例の場合 104が最新のフォルダというわけではなく、番号のフォルダ自体は 104以降もあり、最新ファイルが104にある場合は105以降のフォルダは 空の状態です。 分かりにくい説明ではございますが、よろしくお願いします^^;

  • EXCEL2000 フォルダ内のファイルを検索

    EXCEL2000 フォルダ内のファイルを検索 お分かりになる方がいましたらお力添えの程よろしくお願いします。 任意のフォルダ内で任意のファイルサーチが出来るマクロを実行したいのですが、ファイルサーチの値を全角、半角、大文字、小文字区別なく行いたいのです。 例えば,セル2,2に、topと入力したら、topもtopもTOPもTOPも検索対象に引っかかり、セルに書き出して欲しいのです。 ・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・ Sub ファイル一覧2() Dim vntF As Variant Dim objFS As FileSearch Dim objFSO As FileSystemObject Dim GYO As Long Dim cntFound As Long Set objFS = Application.FileSearch ' FileSearch Set objFSO = New FileSystemObject ' FSO Rows("5:65536").ClearContents Application.ScreenUpdating = False GYO = 4 With objFS .NewSearch .LookIn = Trim(Cells(1, 2).Value) ' Search開始フォルダ .Filename = Trim(Cells(2, 2).Value) ' 探索ファイル式 .SearchSubFolders = True ' サブフォルダも探索 ' 処理開始 If .Execute() <> 0 Then For Each vntF In .FoundFiles With objFSO.GetFile(vntF) GYO = GYO + 1 Cells(GYO, 1).Value = .Name Cells(GYO, 2).Value = .DateLastModified Cells(GYO, 3).Value = _ Left(.Path, Len(.Path) - Len(.Name) - 1) cntFound = cntFound + 1 End With Next vntF End If End With Set objFS = Nothing Set objFSO = Nothing ' 処理結果の表示 If cntFound = 0 Then MsgBox "見つかりません" Else MsgBox cntFound & "個見つかりました" End If End Sub

専門家に質問してみよう