12

csv関連の質問があったのでExcelファイルを
CSVファイル(カンマ区切り)で保存するスクリプトを投稿します。

Excelファイルを開いていない場合は、画面に表示せずに開き、
指定のシートまたはアクティブなシートをCSVへ変換し保存した後、
元のファイルを閉じるスクリプトとなります。
参考まで。

<サンプルスクリプト>

' ファイルのパスをフルパスに変換する
Set fso = CreateObject("Scripting.FileSystemObject")
filePath = fso.GetAbsolutePathName(!元ファイル名!)

' workbookオブジェクトを取得する
Set workbook = Nothing
On Error Resume Next
' 既存のエクセルが起動されていれば警告を抑制する
Set existingXlsApp = Nothing
Set existingXlsApp = GetObject(, "Excel.Application")
existingXlsApp.DisplayAlerts = False

' 一先ずWorkbookオブジェクトをGetObjectしてみる
Set workbook = GetObject(filePath)
Set xlsApp = workbook.Parent

' GetObjectによって新規に開かれたWorkbookなら
' 変数にNothingを代入することで参照が0になるため
' 自動的に閉じられる。
Set workbook = Nothing

' Workbookがまだ存在するか確認する
For Each book In xlsApp.Workbooks
If StrComp(book.FullName, filePath, 1) = 0 Then
' Workbookがまだ存在するので、このWorkbookは既に開かれていたもの
Set workbook = book
xlsApp.Visible = False
End If
Next

' Workbookが存在しない場合は、新たに開く。
If workbook Is Nothing Then
Set xlsApp = Nothing

' Excelが既に開かれていたならそれを再利用する
If Not existingXlsApp Is Nothing Then
Set xlsApp = existingXlsApp
xlsApp.Visible = False
Else
Set xlsApp = CreateObject("Excel.Application")
xlsApp.Visible = False
End If

Set workbook = xlsApp.Workbooks.Open(filePath)
End If

' 警告の抑制を元に戻す
existingXlsApp.DisplayAlerts = True
Set existingXlsApp = Nothing
On Error Goto 0

If workbook Is Nothing Then
Err.Raise 1, "", "指定されたファイルを開くことができません。"
End If

workbook.activate

' ====指定されたシートを取得する==================================================

sheetName = !シート名!
Set worksheet = Nothing
On Error Resume Next
' シート名が指定されていない場合は、アクティブシートを対象とする
If sheetName = "" Then
Set worksheet = workbook.ActiveSheet
Else
Set worksheet = workbook.Worksheets(sheetName)
End If
On Error Goto 0

If worksheet Is Nothing Then
Err.Raise 1, "", "指定されたシートが見つかりません。"
End If

worksheet.activate

csvPath = fso.GetAbsolutePathName(!保存ファイル名!)

xlsApp.DisplayAlerts = False
worksheet.SaveAs csvPath, 6

workbook.Close
xlsApp.Quit
xlsApp.DisplayAlerts = True
xlsApp.Visible = True

Set objRe = Nothing
Set xlsApp = Nothing
Set worksheet = Nothing
Set workbook = Nothing
Set fso = Nothing
Set objWshShell = Nothing

スクリプト探究者 新しいコメントを投稿
回答とコメントは、会員登録(無料)で閲覧できるようになります。