- ベストアンサー
VBAのDirをつかってブックを検索した後のことについて。
piroin654の回答
- piroin654
- ベストアンサー率75% (692/917)
#4です。この場合、 wksは使っていないので、 最初の、 Dim wks As Excel.Worksheet と、終わりの Set wks = Nothing は必要ないです。
関連するQ&A
- フォルダ内の特定ブックだけを1つのブックにまとめる
以前こちらで質問させて頂きましたフォルダ内の特定ブックだけを1にのブックにまとめる方法で、大変助かっていましたがブック名が変更になり、教えて頂いたマクロでは実行できなくなったので自分なりに考えたのですがどうしてもできません。 質問時のブック名は「1_****」と「2_****」で 今回「1_****」だけが「1(3)_****」に変更になりました。 下記のマクロでmyfile = dir(mypath & "1_" & "*.xl*")→myfile = dir(mypath & "1(3)_" & "*.xl*")に変更するのはわかるのですが do until myfile = "" myfile2 = "2" & mid(myfile,2,99)をどう変更すれば良いかわかりません どなたかお助け頂けませんか？ sub macro1() dim myPath as string dim myFile as string dim myFile2 as string mypath = "c:\test\" myfile = dir(mypath & "1_" & "*.xl*") do until myfile = "" myfile2 = "2" & mid(myfile,2,99) workbooks.open mypath & myfile workbooks.open mypath & myfile2 application.displayalerts = false workbooks(myfile).worksheets("2").delete application.displayalerts = true workbooks(myfile2).worksheets("2").move after:=workbooks(myfile).worksheets("1") workbooks(myfile).close true workbooks(myfile2).close false myfile = dir() loop end sub
- 締切済み
- オフィス系ソフト
- エクセルVBAでConsolidate
以下は、ネット検索で見つけたサンプルコードです。 同じフォルダ内の全ブックのSheet１のA1:B10をThisWorkbookのSheet１に統合しています。 Sub test2() Dim MyFile As String, MyPath As String Dim SumFile() As Variant, i As Long MyPath = ThisWorkbook.Path & "\" MyFile = Dir(MyPath, vbNormal) Do Until MyFile = "" If MyFile <> ThisWorkbook.Name Then ReDim Preserve SumFile(i) 'A1からB10の値を変数に代入 SumFile(i) = "'" & MyPath & "[" & MyFile & "]Sheet1'!R1C1:R10C2" i = i + 1 End If MyFile = Dir Loop If i = 0 Then MsgBox "データが有りません": Exit Sub Worksheets("Sheet1").Range("A1").Consolidate Sources:=SumFile() End Sub 質問１ Sheet1だけでなく全シートのA1:B10をThisWorkbookのSheet１に統合するためにはどう書き換えればよいのでしょうか？ 質問２ 上記コードではなぜ、ブックを開かずにデータがとれるのでしょうか？
- ベストアンサー
- オフィス系ソフト
- VBAでブック名の拡張子を除去してシートにコピー
VBA初心者でコード作成で困っております。 下記の通りコードを組みましたが、シート名をブック名に変更して 保存したいのですが、このコードですと拡張子までついてしまいます。 拡張子を除去するためにはどうすればよいでしょうか？ アドバイス宜しくお願い致します。 Sub test() 'シート名の変更 Dim MyPath As String Dim MyFile As String Dim Wb As Workbook MyPath = "C:\TEST\" MyFile = Dir(MyPath & "*.xlsx") Do While MyFile <> "" Set Wb = Workbooks.Open(MyPath & MyFile) ActiveSheet.Name = ActiveWorkbook.Name Application.DisplayAlerts = False Wb.Save Application.DisplayAlerts = True Wb.Close (False) MyFile = Dir() Loop End Sub
- ベストアンサー
- オフィス系ソフト
- Excel 2010 VBA:ファイル名を読み込む
下は複数のcsvファイルを一つに合体するVBAです。これにシートの右端に読み取ったファイル名を追加するにはどうしたらよいでしょうか。 よろしくお願いします。 Sub macro1() Dim myPath As String Dim myFile As String Dim s As String myPath = ThisWorkbook.Path & "\" On Error Resume Next Kill myPath & "合体版.csv" On Error GoTo 0 myFile = Dir(myPath & "*.csv") If myFile = "" Then Exit Sub Open myPath & "合体版.csv" For Output As #1 Do Until myFile = "" Open myPath & myFile For Input As #2 Do Until EOF(2) Line Input #2, s Print #1, s Loop Close #2 myFile = Dir() Loop Close #1 End Sub
- ベストアンサー
- Excel（エクセル）
- エクセルのCSV形式の複数ブックを一括でインポートしたい
あるフォルダ内にある「複数ブック（CSV形式）」をエクセルに一括でインポートしたいのです。フォルダ内にある複数のエクセルブックの名前はばらばですが、形式だけが全て同じです。 Book1 A B C 1 1 1 Book2 A B C 2 2 2 Book3 A B C 3 3 3 ↑ 2つブックがあって最終的には・・・・ Book5 A B C 1 1 1 2 2 2 3 3 3 ↑ こうしたいです。複数ブックの一行目以下のデータ全てをひとつのものにまとめたいのです。（全ての複数のCSVブックは一行目は同じです。2行目以降を追加するみたいな感じです。） いろいろと調べて作ってみたのですが、「デバック」？？で黄色くなって全く上手く行きません。 ご存知であれば是非教えてください。 ・～・・～・・～・・～・・～・・～・・～・・～・・～・・～・ Sub フォルダ指定連結() Dim myShell As Object Dim myFS As Object, myFile As Object Dim myName As String, myPath As String Dim myLine As String, newStr As String Set myShell = CreateObject("Wscript.Shell") myPath = myShell.Specialfolders("Desktop") & "\aaa\" Set myShell = Nothing Set myFS = CreateObject("Scripting.FileSystemObject") myName = Dir(myPath & "\*.csv\") Do While myName <> "" Set myFile = myFS.OpenTextFile(myPath & "\" & myName, 1) myFile.ReadLine '1行目スキップ Do Until myFile.AtEndOfStream myLine = myFile.ReadLine newStr = newStr & myLine & vbCrLf Loop myFile.Close myName = Dir() Loop Set myFile = myFS.CreateTextFile("C:\test.csv\", True) myFile.Write newStr myFile.Close Set myFS = Nothing Set myFile = Nothing End Sub ・～・・～・・～・・～・・～・・～・・～・・～・・～・・～・ これが教えていただいたり、自分で修正を加えたりしたぶんですが・・・。 環境はウィンドウズXPで2002です。
- ベストアンサー
- Windows XP
- excel マクロ PDF化の際のエラーについて
エクセルブックを一括で名前をつけてpdfに変換するようなマクロを作ろうとして作ってみました。 基本は、マクロで印刷を一気に行う要領でpdfをアクティブプリンタに設定したのですが、見かけ上pdfファイルが作成されるものの、開くと破損していますとなってしまい、きちんとpdf化が出来ていないようです。 システムフォントを利用～のエラーは回避できたのですが、無理やりファイル名を指定しているせいでこのようになっているのでしょうか。 お手数ですがアドバイスをお願いします。 マクロの記録ではアクティブプリンタを指定して、プリントアウトというものしか記録されないので、プリントアウトのところが何か間違っているとは思うのですが・・・ 以下コードです。 Sub PrtPDF() Dim MyFile As String, MyPath As String Dim wb As Object Dim fn As String If vbNo = MsgBox("フォルダ内のブックの一括印刷を行いますか？", vbYesNo) Then GoTo CloseFile Dim bookname1 As String bookname1 = "Conv.xls" MyPath = ThisWorkbook.Path & "\" '自分のパスを取得 MyFile = Dir(MyPath & "*.xls", vbNormal) 'パス内のxlsファイル If LCase(MyFile) = LCase(bookname1) Then MyFile = Dir 'MyFileとbookname1が同じファイルの場合スキップする Do Until MyFile = "" '対象ファイルがなくなるまで Set wb = Workbooks.Open(MyPath & "\" & MyFile) '選択したファイルを開く fn = MyPath & "PDF\" & Range("J4").Value & ".pdf" 'アクティブシートを印刷する。 Application.ActivePrinter = "Adobe PDF on Ne07:" ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, PrtoFileName:=fn 'アクティブブックを閉じる。 ActiveWorkbook.Close MyFile = Dir '次のファイルを検索 If LCase(MyFile) = LCase(bookname1) Then MyFile = Dir 'MyFileとbookname1が同じファイルの場合スキップする Set wb = Nothing Loop '繰り返し GoTo ProcessEnd CloseFile: ActiveWorkbook.Close MsgBox "処理を中止しました。" Exit Sub ProcessEnd: MsgBox "処理が終了しました" End Sub
- 締切済み
- Visual Basic
- VBA フォルダ内のファイル名一覧
下のようなコードですが、Dir("C:\見積\*.xls")の部分を このコードを書いてあるブックのあるフォルダの名前をもっと簡単に取得してコードにできないでしょうか。 もうひとつ付け加えたいこともあります。ファイル名一覧にする際、このブックと「XXX.xls」という名前のブック名以外の一覧にしたいのですが、これもお手上げですので、あわせてお願いします。 Sub test() Dim myFile As String Dim fl As Integer myFile = Dir("C:\見積\*.xls") fl = 9 Do While myFile <> "" fl = fl + 1 Cells(fl, 3).Value = myFile myFile = Dir() Loop End sub
- ベストアンサー
- オフィス系ソフト
- Application.DisplayAlerts =Falseでも警告される？
下記のコードを実行するとSheet1という名前のシートがないBookを開いた場合、「統合元ファイル○○のSheet1を開けません」という警告がでます。 無ければ集計しなくていいので「はい」を押せばいいのですが、その都度止まってしまうのは困ります。 Application.DisplayAlerts = False としても警告されるのはなぜでしょうか？出ないようにすることは出来ないのでしょうか？ Sub test03() 'Sheet1のみ開かずに統合 Dim MyFile As String, MyPath As String Dim SumFile() As Variant, i As Long MyPath = ThisWorkbook.Path & "\" MyFile = Dir(MyPath & "*.xls", vbNormal) Do Until MyFile = "" If MyFile <> ThisWorkbook.Name Then ReDim Preserve SumFile(i) Application.DisplayAlerts = False SumFile(i) = "'" & MyPath & "[" & MyFile & "]Sheet1'!R1C1:R10C2" 'A1からB10のLinkを変数に代入 Application.DisplayAlerts = True i = i + 1 End If MyFile = Dir Loop If i = 0 Then MsgBox "データが有りません （￣□￣；）！！": Exit Sub Worksheets("Sheet1").Range("A1").Consolidate Sources:=SumFile() End Sub
- ベストアンサー
- オフィス系ソフト
- ブックの選択について
ブックの選択について 以下のように、マクロのあるブック意外のブックを開いて からマクロのあるブックを選択しようとしてもできません。 具体的には一番下の Workbooks(thisBook).Select が正常に動きません。 なぜでしょうか？ Dim myFName As String Dim macrobook As Object Dim thisBook As Workbook Set thisBook = ThisWorkbook myPath = ActiveWorkbook.Path ChDir myPath myFName = Dir("*S*.xls") Workbooks.Open Filename:=myFName Workbooks(myFName).Activate Worksheets(1).Select Workbooks(thisBook).Select
- ベストアンサー
- Visual Basic
- (VBA) Dir 関数で取得するファイル一覧の順序
タイトルの通り、下記のサンプルコードを実行して取得するファイル一覧の順序についての質問です。 Public Sub Test1() Dim WSH As Object Dim MyPath As String Dim MyFileName As String Set WSH = CreateObject("WScript.Shell") MyPath = WSH.SpecialFolders("MyDocuments") MyFileName = Dir(MyPath & "\" & "*.*") Do Until MyFileName = "" MsgBox MyFileName MyFileName = Dir Loop Set WSH = Nothing End Sub （質問） ファイル名の昇順では取得できないようですが、もしファイル名の昇順に並べ替えるとしたら、 どのように処理したらよいのでしょうか？
- ベストアンサー
- オフィス系ソフト
お礼
丁寧に有難う御座います。