[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『VBAでCSVを可変で取り込むには』(ひでー)
Sub 前準備()
'
Windows("前準備.xls").Activate Sheets("りんご").Select On Error GoTo Err1 With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;D:\前準備\2010_1_@高砂屋_りんご.csv", Destination:=Range("A1")) .Name = "2010_1_@高砂屋_りんご" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 932 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With Retry1:
Sheets("巨峰").Select
On Error GoTo Err2 With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;D:\前準備\2010_1_@高砂屋_巨峰.csv", Destination:=Range("A1")) .Name = "2010_1_@高砂屋_巨峰" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 932 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With Retry2:
Exit Sub
Err1:
Resume Retry1 Err2: Resume Retry2 end sub
[エクセルのバージョン]
Excel2003
[OSのバージョン]
WindowsXP
> D:\前準備のフォルダ内にcsvファイルが入っており、 > (古いデータは消去し毎度新しい2ファイルしか入ってません)
D:\前準備 --- *_りんご.csv --- *_巨峰.csv
> "前準備.xls”のシートに読み込んでいます
2つのCSVファイルをシートにインポートしているということでしょうか? それでしたら、シート名とファイル名以外は 2つの処理は同じなのだから、 サブプロシージャに独立させて、Main側から シート名を指定して2回呼び出せば よさそうです。 (kanabun)
Sub 前準備xlsにCSVインポート() ' Dim myPath As String myPath = "D:\前準備\"
ChDrive myPath ChDir myPath If Right$(myPath, 1) <> "\" Then myPath = myPath & "\"
CSVのインポート "りんご"
CSVのインポート "巨峰"
End Sub
Private Sub CSVのインポート(mySheet As String) Dim myCSV As String Dim qName As String Dim WS As Worksheet
myCSV = Dir("*_" & mySheet & ".csv") If Len(myCSV) = 0 Then MsgBox mySheet & " CSVファイルが見つかりませんでした" Exit Sub End If qName = Dir(myCSV) qName = Left$(qName, Len(qName) - 4)
On Error Resume Next Set WS = ActiveWorkbook.Worksheets(mySheet) On Error GoTo 0 If WS Is Nothing Then MsgBox "シート「" & mySheet & "」がありません" Exit Sub End If With WS.QueryTables.Add(Connection:= _ "TEXT;" & myCSV, Destination:=WS.Range("A1")) .Name = qName .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 932 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1) '列のデータ型が文字列なら 2 にしたほうがよい .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False .Delete '接続の切断 追加 End With End Sub
以下の行は ゴミでした。 コメントアウトしておいてください。
> If Right$(myPath, 1) <> "\" Then myPath = myPath & "\"
(kanabun)
追伸のあった部分はコメントアウトしVBAを起動させたのですが、
”りんごcsvファイルが見つかりませんでした””巨峰csvファイルが見つかりませんでした”とメッセージボックスが出たあと
何もインポートされません。
一応"2"にもしてみましたが同様でした。
D:\前準備のフォルダ内には 2010_1_@高砂屋_りんご.csv と 2010_1_@高砂屋_巨峰.csv が入っています。
部分部分勉強不足の為、理解が追いつかない所がありますが、教えていただいたVBAは
"*_りんご.csv"と"*_巨峰.csv"のファイルが D:\前準備のフォルダに入っていれば、
"前準備.xls”のシートにインポート(シートは、りんご・巨峰の名前で作っています)されるプログラムですか?
> 教えていただいたVBAは "*_りんご.csv"と"*_巨峰.csv"のファイルが > D:\前準備のフォルダに入っていれば、 > "前準備.xls”のシートにインポート(シートは、りんご・巨峰の名前で作っています)されるプログラムですか?
はい。いちおうそのつもりだったんですが、コードをご覧になって分かるように コードには "前準備.xls" というBook名はどこにも登場してません。 代わりに、 Set WS = ActiveWorkbook.Worksheets(mySheet) と、ActiveWorkbookという表現で、アクティブなBook内の「りんご」シートや「巨峰」シート を参照するようになっています。 とりあえず、「りんご」「巨峰」シートの入っている『前準備.xls』をアクティブにして 検証してください。
でも、エラーはそこで起きているのでなく、その前の
> myCSV = Dir("*_" & mySheet & ".csv") > If Len(myCSV) = 0 Then > MsgBox mySheet & " CSVファイルが見つかりませんでした" > Exit Sub > End If の部分なんですよね? こちらでも "D:\前準備" フォルダのなかに 「2010_1_りんご.csv」と「2010_2_巨峰.csv」をおいてテストしてみましたが ちゃんとインポートできました。 どこかフォルダ構成とか が違っているということはないですか?
または > myCSV = Dir("*_" & mySheet & ".csv") の部分を myCSV = Dir("*" & mySheet & "*.csv") と変更して(ワイルドカードを少しあいまいにして) *りんご*.csv などでファイルを拾ってみる とか?
(kanabun)
ファイル名は 2010_1_@高砂屋_1_マスA.csv
2010_1_@高砂屋_2_マスB.csv
2010_1_@高砂屋_3_マスC.csv
2010_1_@高砂屋_4_特別限定.csv
2010_1_@高砂屋_5_身障者.csv
2010_1_@高砂屋_6_ボックス.csv
2010_1_@高砂屋_7_溜.csv
2010_1_@高砂屋_8_維持員.csv
で D:\共有\ナンバリング\本場所\東京場所\アクセス前準備.xls の中のシート分けをマスA・マスB・マスC・特別限定・身障者・ボックス・溜維持員と
し、そのアクセス前準備.xls内で下記のマクロを使っていますが、今後新しいデータに変更した場合でもマクロを利用できるようにしたいです。
たとえば新しいファイルを格納場所に入れたときの名前は
2010_1_A紀の国家_1_マスA.csv
2010_1_A紀の国家_2_マスB.csv
2010_1_A紀の国家_3_マスC.csv
2010_1_A紀の国家_4_特別限定.csv
2010_1_A紀の国家_5_身障者.csv
2010_1_A紀の国家_6_ボックス.csv
2010_1_A紀の国家_7_溜.csv
2010_1_A紀の国家_8_維持員.csv
_マスA.csv など末尾の情報を検知してインポートが可能となるVBAを質問させていただきました。
(kanabun)に考えてもらったVBAで、自分なりに考えて変更した所は
myPath = "D:\前準備\" ⇒ myPath = "D:\共有\ナンバリング\本場所\東京場所\アクセス前準備\"
CSVのインポート "りんご" ⇒ CSVのインポート "マスA"
CSVのインポート "巨峰" ⇒ CSVのインポート "マスB"
追加で CSVのインポート "マスC"
CSVのインポート "特別限定"
CSVのインポート "身障者"
CSVのインポート "ボックス"
CSVのインポート "溜"
CSVのインポート "維持員"
を変更しただけでは駄目なんでしょうか?
ご指摘の通り、りんご・巨峰での質問通りでは問題なく動いておりました。すみません。
下記がいままで実際しようしていたマクロです。いままでは アクセス前準備.xls を開きマクロを実行していました。
(kanabun)が言っていたアクティブはエクセルファイルを開けばアクティブ状態ですよね。
今回の条件で実行させるには他に手を加える所があるのでしょうか?
お手数かけますがよろしくおねがいします。
Sub Access前準備()
'
' Access前準備 Macro
' マクロ記録日 : 2009/6/23 ユーザー名 :
'
'
Windows("Access前準備.xls").Activate Sheets("マスA").Select On Error GoTo Err1 With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;D:\共有\ナンバリング\本場所\東京場所\アクセス前準備\2010_1_@高砂屋_1_マスA.csv", Destination:=Range("A1")) .Name = "マスA" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 932 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With Retry1: Sheets("マスB").Select On Error GoTo Err2 With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;D:\共有\ナンバリング\本場所\東京場所\アクセス前準備\2010_1_@高砂屋_2_マスB.csv", Destination:=Range("A1")) .Name = "マスB" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 932 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With Retry2: Sheets("マスC").Select On Error GoTo Err3 With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;D:\共有\ナンバリング\本場所\東京場所\アクセス前準備\2010_1_@高砂屋_3_マスC.csv", Destination:=Range("A1")) .Name = "マスC" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 1252 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With Retry3: Sheets("特別限定").Select On Error GoTo Err4 With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;D:\共有\ナンバリング\本場所\東京場所\アクセス前準備\2010_1_@高砂屋_4_特別限定.csv", Destination:=Range("A1")) .Name = "特別限定" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 1252 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With Retry4: Sheets("身障者").Select On Error GoTo Err5 With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;D:\共有\ナンバリング\本場所\東京場所\アクセス前準備\2010_1_@高砂屋_5_身障者.csv", Destination:=Range("A1")) .Name = "身障者" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 1252 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With Retry5: Sheets("ボックス").Select On Error GoTo Err6 With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;D:\共有\ナンバリング\本場所\東京場所\アクセス前準備\2010_1_@高砂屋_5_ボックス.csv", Destination:=Range("A1")) .Name = "ボックス" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 932 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With Retry6: Sheets("溜").Select On Error GoTo Err7 With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;D:\共有\ナンバリング\本場所\東京場所\アクセス前準備\2010_1_@高砂屋_7_溜.csv", Destination:=Range("A1")) .Name = "溜" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 932 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With Retry7: Sheets("維持員").Select On Error GoTo Err8 With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;D:\共有\ナンバリング\本場所\東京場所\アクセス前準備\2010_1_@高砂屋_8_維持員.csv", Destination:=Range("A1")) .Name = "維持員" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 932 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With Retry8:
Sheets("マスA").Select Rows("1:1").Select Selection.Insert Shift:=xlDown Range("A1").Select ActiveCell.FormulaR1C1 = "データ" Range("B1").Select ActiveCell.FormulaR1C1 = "方向" Range("C1").Select ActiveCell.FormulaR1C1 = "日付" Range("A1").Select
Sheets("マスB").Select Rows("1:1").Select Selection.Insert Shift:=xlDown Range("A1").Select ActiveCell.FormulaR1C1 = "データ" Range("B1").Select ActiveCell.FormulaR1C1 = "方向" Range("C1").Select ActiveCell.FormulaR1C1 = "日付" Range("A1").Select
Sheets("マスC").Select Rows("1:1").Select Selection.Insert Shift:=xlDown Range("A1").Select ActiveCell.FormulaR1C1 = "データ" Range("B1").Select ActiveCell.FormulaR1C1 = "方向" Range("C1").Select ActiveCell.FormulaR1C1 = "日付" Range("A1").Select
Sheets("特別限定").Select Rows("1:1").Select Selection.Insert Shift:=xlDown Range("A1").Select ActiveCell.FormulaR1C1 = "データ" Range("B1").Select ActiveCell.FormulaR1C1 = "方向" Range("C1").Select ActiveCell.FormulaR1C1 = "日付" Range("A1").Select
Sheets("身障者").Select Rows("1:1").Select Selection.Insert Shift:=xlDown Range("A1").Select ActiveCell.FormulaR1C1 = "データ" Range("B1").Select ActiveCell.FormulaR1C1 = "方向" Range("C1").Select ActiveCell.FormulaR1C1 = "日付" Range("A1").Select
Sheets("ボックス").Select Rows("1:1").Select Selection.Insert Shift:=xlDown Range("A1").Select ActiveCell.FormulaR1C1 = "データ" Range("B1").Select ActiveCell.FormulaR1C1 = "方向" Range("C1").Select ActiveCell.FormulaR1C1 = "日付" Range("A1").Select
Sheets("溜").Select Rows("1:1").Select Selection.Insert Shift:=xlDown Range("A1").Select ActiveCell.FormulaR1C1 = "データ" Range("B1").Select ActiveCell.FormulaR1C1 = "方向" Range("C1").Select ActiveCell.FormulaR1C1 = "日付" Range("A1").Select
Sheets("維持員").Select Rows("1:1").Select Selection.Insert Shift:=xlDown Range("A1").Select ActiveCell.FormulaR1C1 = "データ" Range("B1").Select ActiveCell.FormulaR1C1 = "方向" Range("C1").Select ActiveCell.FormulaR1C1 = "日付" Range("A1").Select
Sheets("マスA").Select Range("A1").Select
'ActiveWorkbook.Save 'ActiveWindow.Close
Exit Sub Err1: Resume Retry1 Err2: Resume Retry2 Err3: Resume Retry3 Err4: Resume Retry4 Err5: Resume Retry5 Err6: Resume Retry6 Err7: Resume Retry7 Err8: Resume Retry8
End Sub
こんにちは。
> 実際はCSVファイルが8ファイルなのと > その格納場所が D:\共有\ナンバリング\本場所\東京場所\アクセス前準備 です。 > > で > D:\共有\ナンバリング\本場所\東京場所\アクセス前準備.xls > の中のシート分けを > マスA・マスB・マスC・特別限定・身障者・ボックス・溜・維持員とし、 > そのアクセス前準備.xls内で下記のマクロを使っていますが、
> 自分なりに考えて変更した所は > > myPath = "D:\前準備\" ⇒ myPath = "D:\共有\ナンバリング\本場所\東京場所\アクセス前準備\" > > CSVのインポート "りんご" ⇒ CSVのインポート "マスA" > CSVのインポート "巨峰" ⇒ CSVのインポート "マスB" > 追加で > CSVのインポート "マスC" > CSVのインポート "特別限定" > CSVのインポート "身障者" > CSVのインポート "ボックス" > CSVのインポート "溜" > CSVのインポート "維持員" >を変更しただけでは駄目なんでしょうか? >ご指摘の通り、りんご・巨峰での質問通りでは問題なく動いておりました。 >すみません。
基本的にその変更・追加で問題ないと思いますよ。
あと > 今後新しいデータに変更した場合でもマクロを利用できるようにしたいです。 ということなので、変更時には 呼び出し側のプログラム内のシート名のリストを変えるだけで、あとは変更なしで 作業できるようにしておくといいですよ。
作業手順としては (1)D:\共有\ナンバリング\本場所\東京場所\アクセス前準備.xls を開いておく。 (2)↓のマクロ内の転記シート名リストを必要に応じて 変更する。 (3) 『アクセス前準備.xls』をアクティブにして↓を実行する。
Sub CSV転記プログラム() '<---- このマクロを実行する Dim myPath As String Dim Sheetnames, Sheetname
' CSVファイルのあるフォルダは アクティブなBook (たとえば 『アクセス前準備.xls』)と同じフォルダとする myPath = ActiveWorkbook.Path
'転記先シート名のリスト(カンマ区切りで書き込む) Sheetnames = Split("マスA,マスB,マスC,特別限定,身障者,ボックス,溜,維持員", ",")
ChDrive myPath ChDir myPath
For Each Sheetname In Sheetnames CSVのインポート CStr(Sheetname) Next
End Sub
(kanabun) 2009-06-27 14:20頃
ファイル名は 2010_1_@高砂屋_1_マスA.csv
2010_1_@高砂屋_2_マスB.csv
2010_1_@高砂屋_3_マスC.csv
2010_1_@高砂屋_4_特別限定.csv
2010_1_@高砂屋_5_身障者.csv
2010_1_@高砂屋_6_ボックス.csv
2010_1_@高砂屋_7_溜.csv
2010_1_@高砂屋_8_維持員.csv
Sub アクセス前準備xlsにCSVインポート() '
Dim myPath As String myPath = "D:\共有\ナンバリング\本場所\東京場所\アクセス前準備\" ChDrive myPath ChDir myPath 'If Right$(myPath, 1) <> "\" Then myPath = myPath & "\"
CSVのインポート "マスA" CSVのインポート "マスB" CSVのインポート "マスC" CSVのインポート "特別限定" CSVのインポート "身障者" CSVのインポート "ボックス" CSVのインポート "溜" CSVのインポート "維持員"
End Sub
Private Sub CSVのインポート(mySheet As String) Dim myCSV As String Dim qName As String Dim WS As Worksheet myCSV = Dir("*_" & mySheet & ".csv") If Len(myCSV) = 0 Then MsgBox mySheet & " CSVファイルが見つかりませんでした" Exit Sub End If qName = Dir(myCSV) qName = Left$(qName, Len(qName) - 4) On Error Resume Next Set WS = ActiveWorkbook.Worksheets(mySheet) On Error GoTo 0 If WS Is Nothing Then MsgBox "シート「" & mySheet & "」がありません" Exit Sub End If With WS.QueryTables.Add(Connection:= _ "TEXT;" & myCSV, Destination:=WS.Range("A1")) .Name = qName .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 932 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 2, 1) '列のデータ型が文字列なら 2 にしたほうがよい .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False .Delete '接続の切断 追加 End With End Sub
横から失礼しますが、A、B、Cの半角全角は一致していますか? ファイル名から直接コピー&ペーストして動かしてみてはどうでしょうか。 (Mook)
> と3回メッセージボックスが表示されインポートされません。 > その後の特別限定・身障者・ボックス・溜・維持員はインポートされております。 > 何が原因でしょうか?
> ファイル名は 2010_1_@高砂屋_1_マスA.csv > 2010_1_@高砂屋_2_マスB.csv > 2010_1_@高砂屋_3_マスC.csv
Sub アクセス前準備xlsにCSVインポート() '
Dim myPath As String myPath = "D:\共有\ナンバリング\本場所\東京場所\アクセス前準備\" ChDrive myPath ChDir myPath
CSVのインポート "マスA" CSVのインポート "マスB" CSVのインポート "マスC" CSVのインポート "特別限定" CSVのインポート "身障者" CSVのインポート "ボックス" CSVのインポート "溜" CSVのインポート "維持員"
End Sub
Mookさんのアドバイスのとおり、シート名が全角でファイル名が半角 ってことではないですか? 現に、シート名"マスA" で、 ファイル名 _マスA.csv となってますし。。。
以下のように、変更してみてはどうでしょう?
Private Sub CSVのインポート(mySheet As String) Dim myCSV As String Dim qName As String Dim WS As Worksheet myCSV = Dir("*_" & StrConv(mySheet,vbWide) & ".csv") If Len(myCSV) = 0 Then myCSV = Dir("*_" & StrConv(mySheet,vbNarrow) & ".csv") If Len(myCSV) = 0 Then MsgBox mySheet & " CSVファイルが見つかりませんでした" Exit Sub End If End If qName = Left$(myCSV, Len(myCSV) - 4) On Error Resume Next Set WS = ActiveWorkbook.Worksheets(mySheet) On Error GoTo 0 '以下 省略
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.