取込データのテストをしています。VBSかjava scriptで下記のスクリプトを

作成していただけないでしょうか。お礼は先着順で300,200,100ポイント差し上げます。

・C:\TEMPにtest_001.xls~test_500.xlsまで連番で500個あります。
test_xxx.xlsのL6のセルとM6のセルにIDと名前を設定してください。
IDと名前は別ファイル(id.csv)に1行ずつID,名前という順番で保存しています。

id.csv
P001,佐藤 一郎
P002,佐藤 二郎
XXXX

test_001.xls
L6=P001
M6=佐藤 一郎

test_002.xls
L6=P002
M6=佐藤 二郎

以上、よろしくお願いします。

回答の条件
  • 1人2回まで
  • 登録:2009/08/29 22:05:02
  • 終了:2009/08/30 11:48:17

回答(1件)

id:HALSPECIAL No.1

HALSPECIAL回答回数407ベストアンサー獲得回数862009/08/29 22:40:26

ポイント300pt

VBSです

Option Explicit
Const XLS   = "C:\TEMP\test_{0}.xls"    '{0}は置換されます
Const IDCSV = "C:\TEMP\id.csv"
Const ForReading = 1 '読み込み

Dim objFileSys, objCsvFile
Set objFileSys = WScript.CreateObject("Scripting.FileSystemObject")

If objFileSys.FileExists(IDCSV) = False Then
    MsgBox "id.csvなし"
    WScript.Quit
End If
Set objCsvFile = objFileSys.OpenTextFile(IDCSV,ForReading)

Dim objExcel
Set objExcel = WScript.CreateObject("Excel.Application")
objExcel.Visible = True


Do Until objCsvFile.AtEndOfStream = True
    Dim line, ary, id, nm, xl
    line = objCsvFile.ReadLine
    ary = Split(line,",")
    id = ary(0)
    nm = ary(1)
    '
    xl = XLS
    xl = Replace(xl,"{0}",Mid(id,2))
    If objFileSys.FileExists(xl) = True Then
        objExcel.Workbooks.Open xl
        objExcel.Range("L6").Value = id
        objExcel.Range("M6").Value = nm
        objExcel.DisplayAlerts = False
        objExcel.Workbooks(1).Close True
    End If
Loop

objExcel.Quit
objCsvFile.Close

Set objExcel   = Nothing
Set objCsvFile = Nothing
Set objFileSys = Nothing

MsgBox "おわり"

id:kuruma_neko

エクセルを起動するパスをidから取っていますが、対象のエクセルはtest_001.xls~test_500.xls

までの連番で500個なので、format(cnt,"000")に変更しました。また、formatを使うことにより

VBAからの実行に変えました。その他はやりたい機能を満たしていましたので、十分作業が捗りました。ありがとうございました。

2009/08/30 11:47:24

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません