エクセルの学校：全文検索：Hyper Estraier：フォルダ選択

Results of 1 - 1 of about 1437 for フォルダ選択 (0.009 sec.)

フォルダ (4447), 選択 (24694)

[[20091119112315]]: #score: 4655; @digest: 46906852e0bba936e10ce3e73f1e1b9b; @id: 46464; @mdate: 2009-12-04T08:03:39Z; @size: 9989; @type: text/plain; #keywords: myfilenamea (62575), myfilecount (58020), myfilename (51023), myfilelist (48468), mydira (32493), myfilecounta (29317), shinv230 (29217), myfilelista (24510), mydirb (22510), mydir (20563), 示se (14193), 択ダ (13131), ダ選 (12855), myobj (8358), browseforfolder (8247), ォル (7015), タ1 (6910), ダ¥ (6784), ルダ (6007), フォ (4922), 別フ (4271), ファ (4141), 存先 (3715), fileformat (3687), ァイ (3206), 保存 (2906), イル (2684), displayalerts (2606), csv (2502), アロ (2098), ダー (2063), ルフ (2016); 『同一フォルダー内にあるcsvファイルを別ファイルにxls形式で一括保存』（shinv230）
Excel 2003 同一フォルダー内にあるcsvファイルを1つずつ開いて別フォルダーにxls形式で保存していますがファイルが約200個となると時間がかかり苦労しています。 フォルダー内のcsvファイルを一括して別フォルダーにxls形式で保存する方法は無いでしょうか? よろしくお願いします。 ---- dir関数でフォルダ内のCSVファイルを一つずつ開いて、同名（または、別名の）のエクセルファイルに直して保存 DIRで検索すれば、ヒットすると思います。（SHIOJII ---- SHIOJIIさんアドバイスありがとうございます。 DIRで検索しCSVファイルをエクセルファイルに直して元のフォルダーに保存することはできました。しかし,変換後のエクセルファイルを別フォルダーに保存する方法が分かりません。再度,アドバイスをお願いします。(shinv230) ---- 現在のコードはどうなっているのでしょうか。ファイル名指定のところでフォルダも指定すればできませんか。（たるむ） ---- 現在のコードは,以下になっています。(INAさんのサンプルを流用させいただきました) 保存先のフォルダーは,毎月変更となりますので一定ではありません。 Sub xls変換() Dim myObj As Object Dim myDir As String Dim myFileName As String Dim myFileList As String Dim myFileCount As Long Dim wb As Workbook 'フォルダ選択ダイアログの表示 Set myObj = CreateObject("Shell.Application"). _ BrowseForFolder(0, "フォルダを選択してください", 0) If myObj Is Nothing Then Exit Sub myDir = myObj.Items.Item.Path If Right(myDir, 1) <> "¥" Then myDir = myDir & "¥" 'フォルダ内のExcelファイルを確認 myFileName = Dir(myDir & "*.xls") Do While myFileName <> "" If myFileName <> ThisWorkbook.Name Then myFileList = myFileList & Chr(13) & myFileName myFileCount = myFileCount + 1 End If myFileName = Dir() Loop If myFileCount = 0 Then MsgBox "ファイルは見つかりませんでした。マクロを終了します。", 48 Exit Sub ElseIf vbNo = MsgBox(myFileCount & " 個の .xls ファイルが見つかりました。マクロを実行しますか?" _ & Chr(13) & myFileList, 4, "ファイル確認") Then MsgBox "キャンセルしました。" Exit Sub End If 'CSV処理 myFileName = Dir(myDir & "*.xls") Do While myFileName <> "" Application.DisplayAlerts = False Application.ScreenUpdating = False If myFileName <> ThisWorkbook.Name Then Set wb = Workbooks.Open(myDir & myFileName) wb.SaveAs Filename:=myDir & Left(myFileName, Len(myFileName) - 3) & "csv", _ FileFormat:=xlCSV wb.Close End If myFileName = Dir() Loop Application.DisplayAlerts = True Application.ScreenUpdating = True MsgBox "完了しました。" End Sub 変更箇所は以下の部分ですか? If myFileName <> ThisWorkbook.Name Then Set wb = Workbooks.Open(myDir & myFileName) wb.SaveAs Filename:=myDir & Left(myFileName, Len(myFileName) - 3) & "csv", _ FileFormat:=xlCSV wb.Close End If (shinv230) ---- はい、そうです。開くファイルのフォルダを選択しているようですから、同様に保存先のフォルダも選択できるようにすればよいですね。（たるむ） ---- そのコードはエクセルファイルをCSVにしていると思いますが。。。御質問は＞csvファイルを別ファイルにxls形式で一括保存でしたよね? 御質問内容が違っていた? それとも、＞DIRで検索しCSVファイルをエクセルファイルに直して元のフォルダーに保存することはできました。と言う事なので、実際は載せておられるのと違うコードを使って居られる? (HANA) ---- HANAさんご指摘ありがとうございます。質問内容は,csvファイルを別フォルダにxls形式で一括保存です。また,コードについてはご指摘どおり間違っています。参考にしたコードがエクセルファイルからCSVファイルに変換するものでしたので2通り作成したため, 掲載するときに間違ってしまいました。正しいコードは,以下になります。 Sub CSV変換() Dim myObj As Object Dim myDir As String Dim myFileName As String Dim myFileList As String Dim myFileCount As Long Dim wb As Workbook 'フォルダ選択ダイアログの表示 Set myObj = CreateObject("Shell.Application"). _ BrowseForFolder(0, "フォルダを選択してください", 0) If myObj Is Nothing Then Exit Sub myDir = myObj.Items.Item.Path If Right(myDir, 1) <> "¥" Then myDir = myDir & "¥" 'フォルダ内のCSVファイルを確認 myFileName = Dir(myDir & "*.csv") Do While myFileName <> "" If myFileName <> ThisWorkbook.Name Then myFileList = myFileList & Chr(13) & myFileName myFileCount = myFileCount + 1 End If myFileName = Dir() Loop If myFileCount = 0 Then MsgBox "ファイルは見つかりませんでした。マクロを終了します。", 48 Exit Sub ElseIf vbNo = MsgBox(myFileCount & " 個の .csv ファイルが見つかりました。マクロを実行しますか?" _ & Chr(13) & myFileList, 4, "ファイル確認") Then MsgBox "キャンセルしました。" Exit Sub End If 'Excel処理 myFileName = Dir(myDir & "*.csv") Do While myFileName <> "" Application.DisplayAlerts = False Application.ScreenUpdating = False If myFileName <> ThisWorkbook.Name Then Set wb = Workbooks.Open(myDir & myFileName) wb.SaveAs Filename:=myDir & Left(myFileName, Len(myFileName) - 3) & "xls", _ FileFormat:=xlExcel3 wb.Close End If myFileName = Dir() Loop Application.DisplayAlerts = True Application.ScreenUpdating = True MsgBox "完了しました。" End Sub 現在の状況は,マクロを実行すると元フォルダにCSVファイルとエクセルファイルの両方が保存されます。別フォルダへの保存方法については,まだ完成していません。(shinv230) ---- ＞'フォルダ選択ダイアログの表示で、フォルダを選択するとその後＞If Right(myDir, 1) <> "¥" Then myDir = myDir & "¥" の処理まで進むと、[myDir]という変数に選択したフォルダのパスができていることはつかめていますか? たとえば、Cドライブ直下の新しいフォルダを選んだ場合 [myDir] に C:¥新しいフォルダ¥ が完成しているので [myFileName]にデータ1.csv が入っていた時に＞Workbooks.Open(myDir & myFileName) myDir & myFileName → "C:¥新しいフォルダ¥" & "データ1.csv" → "C:¥新しいフォルダ¥データ1.csv" になるので、目的のファイルが開けます。保存するときは＞Filename:=myDir & Left(myFileName, Len(myFileName) - 3) & "xls" [myFileName]にデータ1.csv が入っていた場合 Left(myFileName, Len(myFileName) - 3) で、「データ1.」が得られるので myDir & Left(myFileName, Len(myFileName) - 3) & "xls" → "C:¥新しいフォルダ¥" & "データ1." & "xls" → "C:¥新しいフォルダ¥データ1.xls" として（の場所に）保存されます。ですから、＞マクロを実行しますか? で実行することにしたら＞'フォルダ選択ダイアログの表示で、保存するフォルダを選びます。 [myDir]に入っている情報はまだ必要なので（CSVファイルを開くときに使います）新しい変数を用意して、そこにフォルダまでのパスを作成し保存するFilenameの所で使うようにします。 shinv230さんが書いておられる＞変更箇所は以下の部分ですか? の部分の変更と共に（というか、変更するために?）たるむさんが書いておられる＞同様に保存先のフォルダも選択できるようにすればが追加で必要です。それに伴い、新しい変数の宣言も必要になってきます。 Dim myDir As String これは、ファイルが保存してあるフォルダの文字列が入っているので新しく、ファイルを保存するフォルダの文字列を入れる変数を追加してください。 (HANA) ---- HANAさんご指導いただいてから時間がだいぶ過ぎましたが無事完成しました。以下に完成後のコードを掲載させて頂きます。 Sub CSV変換() Dim myObjA As Object Dim myDirA As String Dim myFileNameA As String Dim myFileListA As String Dim myFileCountA As Long Dim wb As Workbook Dim myObjB As Object Dim myDirB As String '変換元フォルダ選択ダイアログの表示 Set myObjA = CreateObject("Shell.Application"). _ BrowseForFolder(0, "変換元のフォルダを選択して「OK」をクリックしてください", 0) If myObjA Is Nothing Then Exit Sub myDirA = myObjA.Items.Item.Path If Right(myDirA, 1) <> "¥" Then myDirA = myDirA & "¥" 'フォルダ内のCSVファイルを確認 myFileNameA = Dir(myDirA & "*.csv") Do While myFileNameA <> "" If myFileNameA <> ThisWorkbook.Name Then myFileListA = myFileListA & Chr(13) & myFileNameA myFileCountA = myFileCountA + 1 End If myFileNameA = Dir() Loop If myFileCountA = 0 Then MsgBox "ファイルは見つかりませんでした。変換を終了します。", 48 Exit Sub ElseIf vbNo = MsgBox(myFileCountA & " 個の .csv ファイルが見つかりました。変換を実行しますか?" _ & Chr(13) & myFileListA, 4, "ファイル確認") Then MsgBox "キャンセルしました。" Exit Sub End If '保存先フォルダ選択ダイアログの表示 Set myObjB = CreateObject("Shell.Application"). _ BrowseForFolder(0, "変換後の保存先フォルダを選択して「OK」をクリックしてください", 0) If myObjB Is Nothing Then Exit Sub myDirB = myObjB.Items.Item.Path If Right(myDirB, 1) <> "¥" Then myDirB = myDirB & "¥" 'Excel処理 myFileNameA = Dir(myDirA & "*.csv") Do While myFileNameA <> "" Application.DisplayAlerts = False Application.ScreenUpdating = False If myFileNameA <> ThisWorkbook.Name Then Set wb = Workbooks.Open(myDirA & myFileNameA) wb.SaveAs Filename:=myDirB & Left(myFileNameA, Len(myFileNameA) - 3) & "xls", _ FileFormat:=xlExcel3 wb.Close End If myFileNameA = Dir() Loop Application.DisplayAlerts = True Application.ScreenUpdating = True MsgBox "完了しました。" End Sub 今後ともご指導願います。（shinv230) ...; https://www.excel.studio-kazu.jp/wiki/kazuwiki/200911/20091119112315.txt - [detail] - similar

PREV NEXT

訪問者：カウンタ