• ベストアンサー

【vba】もしフォルダがなければ作成したい

Sub test() If Dir("C:\バックアップ\" & Date$) <> "" Then 'ファイルがないなら作成 MkDir "C:\バックアップ\" & Date$ End If End Sub このコードを実行しても ファイルがあってもなくても作成されないのですが 何がおかしいのでしょうか?

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

  • ベストアンサー
  • myRange
  • ベストアンサー率71% (339/472)
回答No.1

フォルダーを作成するわけですから Dir関数にフォルダーかどうかの引数vbDirectoryを セットしないといけません。 また、なかったらという場合のIFステートメントも間違い。 Sub test()  If Dir("C:\バックアップ\" & Date$, vbDirectory) = "" Then    MkDir "C:\バックアップ\" & Date$  End If End Sub  

lokijuh
質問者

お礼

サンプルどおり「=」にしてvbDirectoryを付けたらできました! ありがとうございます。

関連するQ&A

  • VBAでファイルを消したい

    こんばんわ! VBAでエクセルファイルをバックアップしながら使用しているのですが、10個以上ファイルが溜まったら一番古いものを消したいです。 途中まではできているのですが、古いファイルを選択する方法が分かりませんToT 途中までのソースを乗せますので、アドバイスの程よろしくお願いいたします。 ================== Private Sub backup_bot_Click() Dim Path As String, WSH As Variant Dim fc As Long Dim fn As String 'マイドキュメントにバックアップ Set WSH = CreateObject("WScript.Shell") Path = WSH.SpecialFolders("MyDocuments") & "\test" If Dir(Path, vbDirectory) = "" Then MkDir (Path) End If 'ファイルコピー FileCopy "c:test_date\aaa.xls", Path & "\aaa" & Format(Now, "yyyymmdd") & ".xls" 'ファイル数確認 fn = Dir(Path & "\aaa*.xls") Do While fn <> "" fc = fc + 1 fn = Dir() Loop '10件以上消去 If fc > 10 Then 'ここが分かりません! End If End Sub ================== あ~ちなみにoffice2003エクセルを使用しています。 XP以降のOSで動かしたいです!

  • フォルダの中身がカラか調べる

    vbaです。 フォルダ(新しいフォルダ)を作り、その中にサブフォルダ(Test用フォルダ)を作って --------------------------------------------------------- Sub フォルダの中身がカラか調べる() If Dir("D:\新しいフォルダ\Test用フォルダ\*.*") = "" Then MsgBox "カラです" Else MsgBox "カラではありません" End If End Sub --------------------------------------------------------- を実行すると、新しいフォルダの中にフォルダがあるのに、 「カラです」が表示されてしまいます。 新しいフォルダのファイルサイズは0です。 If Dir("D:\新しいフォルダ\Test用フォルダ\*.*") = "" Then のコードは、フォルダの中のファイル数ではなく、 フォルダのサイズを取得してしまうのでしょうか?

  • エクセルVBAでフォルダの作成-2

    先ほどダブルクリックすると、クリックしたその名前にしたフォルダを作成して、ハイパーリンクを設定する、ということで質問させていただき、良い回答を頂き質問を閉じましたが、また質問があります。 A列をクリックするとイベントを発生させるのを、 A4セルから、その下のデータが入っているセルまで をイベントが有効な範囲にしたいと思い、考えています。 「If Target.Column = 1 Then」の部分がそれだと思い、 If Target.Range("A4", Range("A" & Rows.Count).End(xlUp)) Then のように考えて実行しましたが、これはダメでした。 このように限られた範囲に変更すにはどのようにすればいいでしょうか? Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Const path As String = "D:\TEMP\倉庫\" Dim wkStr As String  If Target.Column = 1 Then   wkStr = path & Target.Value   If Dir(wkStr, vbDirectory) = vbNullString Then    MsgBox wkStr & "フォルダがありません。作成します。"    MkDir wkStr   Else    MsgBox wkStr & "フォルダは存在します。"   End If   ActiveSheet.Hyperlinks.Add Anchor:=Target, Address:=wkStr  End If End Sub

  • VBA:カウンターの i の値が開放されなくて困っています。

    以下のコードを実行する度に、カウンター i の値がリセット(開放)されずに積算されて困っています。なぜか教えて下さい。宜しくお願い致します。 以下のコードは、簡単に言えばcsvファイルをカウンター i で数えています。したがって、少なくともCSVファイルを一つ作成して実行して下さい。 Option Explicit Dim FiName As String, FoName As String Dim EachFiName As String Dim i As Integer Sub Test() MsgBox i '二回目にこのコードを実行するとiが積算されます。 FiName = Application.GetOpenFilename If FiName = "False" Then Exit Sub Else If Right(FiName, 3) <> "csv" Then MsgBox "Chose a CSV file." Exit Sub End If End If FoName = Left(FiName, InStrRev(FiName, "\", -1, vbTextCompare)) EachFiName = Dir(FoName & "*.csv") Do While EachFiName <> "" i = i + 1 EachFiName = Dir() Loop End Sub

  • Excel2007VBAファイルの開き方について

    ●質問の主旨 Cドライブのフォルダにあるファイルを下記コードで開こうとしましたが、 開くことができませんでした。 1.なぜ下記コードでは開くことができないのでしょうか? 2.開くためにはコードを書き換える必要があるのでしょうか? 3.書き換えるとすればどのように書き換えれば良いでしょうか? ご存知の方ご教示願います。私はVBA初心者です。 ●質問の捕捉 コードはあるVBAの参考書をまるまる引用したものです。 その説明として、 「該当ファイルの存在を予めチェックし、存在すれば開き、 存在しないときはメッセージを表示する」 とあります。 もちろん"C\data\test.xlsm"という場所、ファイルは予め用意しています。 ●コード Sub 存在するときだけ開く() myfile = "C\data\test.xlsm" If Dir(myfile) <> "" Then Workbooks.Open myfile Else MsgBox "ファイルが存在しません" End If End Sub

  • エクセルVBAで指定場所にフォルダー作成

    エクセルのVBAマクロ機能を使い、 自動フォルダー作成&リンクするマクロを作成したのですが、 現在のマクロですと「A(仮名)」の中にフォルダーに作ってしまいますので 下記の様に階層で指定出来る様にしたいのですが、教えて頂けないでしょうか? 出来れば、そのままマクロ貼り付けで使える様にしたいので、 下記に途中までのマクロを編集して頂ければ助かります。 「A(仮名)」と言うフォルダーの中にエクセルファイルの管理表を入れ 「A」のフォルダーの中に「B(仮名)」と言うフォルダーを作り、 その中に管理台帳で自動作成されるフォルダーがつくられる様にしたい。 現在のマクロ Sub MakeHyLink() Dim wkStr As String If ActiveCell.Column <> 1 Then Exit Sub If ActiveCell.Value = "" Then MsgBox "アクティブセルは未入力、やり直し" Exit Sub End If wkStr = ThisWorkbook.path & "\" & ActiveCell.Value If Dir(wkStr, vbDirectory) = "" Then MsgBox "フォルダー:" & wkStr & vbLf & " を、作成します。" MkDir wkStr Else MsgBox "フォルダー:" & wkStr & vbLf & " は、存在します。" End If ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell, Address:=wkStr End Sub

  • フォルダー内のファイルのリンク VBA

    以前、カーソールを置いた部分のテキストとフォルダーの中にあるファイルが一致した場合、 ボタンを押す事によりハイパーリンクを付けるVBAを教えて頂き、現在も活用をさせて頂いています。 今までエクセル「E」列を対象にしていたのですが、 使用しているうちに前列に項目を入れたくなり「E」列の前に2列追加し、 対象の列が「E」列から「G」列の変更になりました。 それから新たにリンクを作成しようとしても実行出来なくなりました。 追加した前列を消しても駄目に。 素人なりに列を指定しているところを変えてみたのですが駄目でして。 If .Column <> 5 Or .Value = "" Then Exit Subを If .Column <> 7 Or .Value = "" Then Exit Subに。 列を変えた場合は、何処をどうすれば良いのでしょうか? 申し訳ありませんが、教えて頂けないでしょうか? 元のVBA Sub Test() Dim fName As String fName = ThisWorkbook.path & "\test\test-a\" With ActiveCell If .Column <> 5 Or .Value = "" Then Exit Sub fName = fName & .Offset(0, -4).MergeArea.Cells(1, 1).Value & _ "\" & .Value & ".prt" If Dir(fName) <> "" Then ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell, Address:=fName End If End With End Sub

  • VBAでMP3を鳴らしたい

    vbaについて質問です。 MP3ファイルを鳴らしたいのですがうまくいきません。 --------------------------------------------------------- Sub Macro1() Dim SoundFile As String SoundFile = "C:\終了音.mp3" If Dir(SoundFile) = "" Then MsgBox SoundFile & vbCrLf & "がありません。", vbExclamation Exit Sub End If Shell "mplay32.exe /play /close " & SoundFile End Sub --------------------------------------------------------- を実行すると、 「Shell "mplay32.exe /play /close " & SoundFile」 の部分で 実行時エラー53 ファイルが見つかりません。 になります。 しかし、 If Dir(SoundFile) = "" Then MsgBox SoundFile & vbCrLf & "がありません。", vbExclamation Exit Sub End If の部分では問題ないので、ファイルはある事になってると思うのですが、 なぜ「Shell "mplay32.exe /play /close " & SoundFile」の部分でエラーになるのでしょうか? スペックは、エクセル2007、windows7です。 ご回答よろしくお願いします。

  • VBAで新しいフォルダを作成するには

    エクセル2010です。 新しいフォルダを作成するにはMkDir関数というのはわかりますが、フォルダがなければ作る、あれば作らないようにしたいのです。 そのやりかたをお教えいただけませんでしょうか? やりたいことは以下のようなことです。 まず、対象フォルダを指定します。 その中に多数のエクセルのBOOKがあります。 このマクロがあるBOOKのSheet1のA列に「名前リスト」があります。 名前が一致するものを、ファイルコピーして、「名前リスト」の右隣B列のセルにある「区分リスト」と同じ名前のサブフォルダ(このマクロがあるBOOKのフォルダのすぐ下です。)に貼り付ける。 ここまでは、以下のコードで少量のデータでのテストはうまくいきました。 しかし、実際には対象が1,000件近くあり、事前に作っておかなければいけないサブフォルダも何十かになります。 そこで、あらかじめサブフォルダを用意するのではなく、このマクロを作動させると自動的にサブフォルダまで作るようにできないかと欲張った質問です。 Sub TEST01()   Dim myPth(1) As String   Dim myCl As Range   Dim wb As Workbook      Set wb = ThisWorkbook   myPth(0) = wb.Path      With Application.FileDialog(msoFileDialogFolderPicker)     If .Show = True Then       myPth(1) = .SelectedItems(1) '対象フォルダ指定     Else       MsgBox "キャンセル"       Exit Sub     End If   End With      With wb.Sheets("Sheet1")     For Each myCl In .Range("A2:A11")       FileCopy myPth(1) & "\" & CStr(myCl.Value) & ".xlsx", myPth(0) & "\" & myCl.Offset(, 1).Value & "\" & CStr(myCl.Value) & ".xlsx"       myCl.Offset(, 2).Value = "完了"     Next myCl   End With End Sub

  • VBA フォルダ内の複数Excelファイルを開く

    お世話になります。 XP エクセル2003使用です。 フォルダー内にある複数のすべてのエクセルを開くコードを 下記の解答をそのままコピーして実行しました。 (以下、このエクセルファイルを「実行ファイル.xls」と呼びます) http://okwave.jp/qa/q2598781.html (コードは最後尾に転記(※)) 問題点は、実行ファイル.xlsから実行した 開きたいエクセルファイルは、 Workbook_Open()で自動実行して、 最後に、ThisWorkbook.Closeで閉じるので、 マクロの実行がループの途中(1回目)で 実行ファイル.xls のコードの実行も終了してしますことです。 (実行ファイル.xls のファイルは開いたままです) つまり、ThisWorkbook.Closeでエクセルを閉じたときに マクロの実行までもが終わってしまうので、 実行ファイル.xlsに戻ってきません。 この問題を解決するための方法として 下記2点を調べましたが、力不足で自己解決できません。 --------------------- 1  実行ファイル.xls から開きたいエクセルファイルを開く時に 何かしらの命令文または引数を記述しておく。  → 解決のヒントを見つけることができませんでした。 --------------------- 2 実行ファイルをエクセルではなく、VBS(VBScript)で記述する。 この場合、参考にしたコードを、 VBS用に書き換えれば良いと思いますが、 VBSは記述したことがないので、さっぱりです。 方法として間違っていなければ、 できれば、どなた様か当該コードを VBS用で記述いただけませんでしょうか? --------------------- 一番良い方法が分からないので、 お力添えいただきたいのです。 よろしくお願いします。 --------------------- (※)参考コード --------------------- Sub OpenAllBooks()   Dim FileName As String   Dim OpenedBook As Workbook   Dim IsBookOpen As Boolean      FileName = Dir("*.xls")   Do While FileName <> ""     If FileName <> ThisWorkbook.Name Then       IsBookOpen = False       For Each OpenedBook In Workbooks         If OpenedBook.Name = FileName Then           IsBookOpen = True           Exit For         End If       Next       If IsBookOpen = False Then         Workbooks.Open (FileName)  ←この処理の後に戻ってこれません       End If     End If     FileName = Dir()   Loop End Sub

専門家に質問してみよう