On Error Resume Next '################################################################ '第一引数にOutlookからエクスポートしたファイルを指定します。 '以下を行います '1、ヘッダーの変換 '2、氏名が空の場合、表示名を名前に設定 '3、wk4形式にして保存 ' 'created by http://www.grot3.com/ '################################################################ Set objShell = WScript.CreateObject("WScript.Shell") Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") '##### IOファイル名指定 ########################################################### inputFileName = objFSO.GetAbsolutePathName(WScript.Arguments(0)) If inputFileName="" Then objShell.Popup "使用方法:" & vbCrLf & vbCrLf & "このファイルにOutlookからエクスポートしたアドレス帳(csv)ファイルをドラッグして下さい。",0,"使用方法", vbInformation Wscript.Quit End If inputFileDirectory = objFSO.GetParentFolderName(inputFileName) '一時ファイル FileArgs = 1 Do If objFSO.FileExists(inputFileDirectory & "\address" & FileArgs & ".csv") = True then FileArgs = FileArgs + 1 Else outputFileName = inputFileDirectory & "\address" & FileArgs & ".csv" Exit Do end if Loop outputFileNameWk4 = inputFileDirectory & "\address.wk4" If objFSO.FileExists(outputFileNameWk4) = True then Wscript.Echo "ファイル" & outputFileNameWk4 & "は既に存在しています。" Wscript.quit End If 'outputFileName = inputFileDirectory & "\address2.csv" outputFileNameWk4 = inputFileDirectory & "\address.wk4" '変換処理 Set objReadStream = objFSO.OpenTextFile(inputFileName,1,false) Set objUpdateStream = objFSO.OpenTextFile(outputFileName,8,true) Do Until objReadStream.AtEndOfStream strLine = objReadStream.ReadLine aryStrings = Split(strLine, ",") readLineNum=1 '##### 1行目のみ -Start ##################################################### If readLineNum = 1 Then strLine = Replace(strLine,"会社名","CompanyName") strLine = Replace(strLine,"部署名","Department") strLine = Replace(strLine,"表示名","DisplayName") strLine = Replace(strLine,"名","FirstName") strLine = Replace(strLine,"姓","LastName") strLine = Replace(strLine,"ミドル ネーム","MiddleName") strLine = Replace(strLine,"電子メール アドレス","MailAddress") strLine = Replace(strLine,"勤務先の番地","OfficeStreetAddress") strLine = Replace(strLine,"勤務先の市区町村","OfficeCity ") strLine = Replace(strLine,"勤務先の郵便番号","OfficeZIP") strLine = Replace(strLine,"勤務先の都道府県","OfficeState") strLine = Replace(strLine,"勤務先の国または地域","OfficeCountry") strLine = Replace(strLine,"勤務先電話番号","OfficePhoneNumber") strLine = Replace(strLine,"勤務先ファックス","OfficeFAXPhoneNumber") strLine = Replace(strLine,"自宅の郵便番号","Zip") strLine = Replace(strLine,"自宅の市区町村","City") strLine = Replace(strLine,"自宅の番地","StreetAddress") strLine = Replace(strLine,"自宅の都道府県","State") strLine = Replace(strLine,"国または地域","Country") strLine = Replace(strLine,"自宅電話番号 :","PhoneNumber") strLine = Replace(strLine,"自宅ファックス","HomeFAXPhoneNumber") strLine = Replace(strLine,"携帯電話","CellPhoneNumber") strLine = Replace(strLine,"個人 Web ページ","WebSite") strLine = Replace(strLine,"役職","JobTitle") strLine = Replace(strLine,"オフィスの場所","Location") End If '##### 1行目のみ -End ##################################################### '##### 氏名が空の場合 -Start ##################################################### If aryStrings(0)="" and aryStrings(1)="" Then DisplayName = aryStrings(3) '##### 表示名に『,』カンマが含まれていた場合の対処 ###################### If InStr(DisplayName, """") <> 0 And InStr(2,DisplayName, """") = 0 Then LoopCount=3 Do LoopCount=LoopCount+1 DisplayName = DisplayName & "," & aryStrings(LoopCount) Loop until InStr(aryStrings(LoopCount), """") <> 0 End If ' objUpdateStream.WriteLine DisplayName & strLine '######### 氏名が空の場合FirstNameに(表示名を代入) objUpdateStream.WriteLine "," & DisplayName & Replace(strLine,",","",1,1) '######### 氏名が空の場合LastNameに(表示名を代入) Else objUpdateStream.WriteLine strLine '######### 氏名が空でない場合(そのまま追記) End if readLineNum=readLineNum+1 Loop objReadStream.close objUpdateStream.close '##### wk4フォーマットで保存 ###################################################### set objExcel = CreateObject("Excel.Application") set objAddressBook = objExcel.workbooks.open(outputFileName, 1) objAddressBook.SaveAs outputFileNameWk4,38 objAddressBook.Close False objFSO.DeleteFile outputFileName, True objExcel.quit