指定のエクセルファイルが開いてなければ新規OPEN、あればデーター上書き
業務上で、作成したファイルが未保存状態で、古い内容のデーターファイルが読み込まれるという事故が度々が起こったので、ファイルにデーターを追加するたびに保存処理をするという制御を入れることになりましたが、ちょっと躓いたので忘備録的に記します。
やりたかったことは、指定のファイルが開いていなければエクセルを起動して開く！
なければ、新規で開く！
ソースは少し省いたところもありますが、下のような感じです。
サンプルソース
Dim objExl As Object
'########################################################################
'初期化処理
'########################################################################
Private Sub Initialize()
Call SetExlObject
End Sub
'########################################################################
'ボタンを押すとCSVファイルにデーターを書き込む
'########################################################################
Private Sub btn_Create_data_Clickr()
Dim ExpFile As String
Dim ExpPath As String
Dim ExpFileName As String
Dim ExpDRange As String
Dim srcWS As Worksheet
Dim srcWB As Workbook
Dim tgtWB As Workbook
Dim blFopen As Boolean
ExpPath = "C:\hoge"
ExpFile = "hoge.csv"
ExpFileName = ExpPath & "\" & ExpFile
blFopen = False
Set tgtWB = getWorkbookByName(ExpFile)
'CSVファイルが開いていなければ、ファイルのオブジェクト取得
If tgtWB Is Nothing Then
Set srcWB = objExl.Workbooks.Open(ExpFileName)
'CSV開いていれば、開いているファイルのオブジェクトを取得
Else
Set srcWB = tgtWB
blFopen = True
End If
'ワークシートの取得
Set srcWS = srcWB.Worksheets(1)
'データーの初期化処理 初めてファイルを開いた時
If blFopen = False Then
Call AllClear_Data(srcWS, ExpFile, ExpDRange)
End If
'データー書き込み処理
Call WriteData(srcWS)
On Error GoTo Exception
srcWB.Save
Exception:
'MsgBox Err.Number & "/" & Err.Description
Exit Sub
End Sub'########################################################################
'指定のExcelファイルがある場合はオブジェクトを返し、無ければNothingを返す
'########################################################################
Private Function getWorkbookByName(targetWorkbookName) As Workbook
Dim TempWorkbook As Workbook
For Each TempWorkbook In objExl.Workbooks
If TempWorkbook.Name = targetWorkbookName Then
Set getWorkbookByName = TempWorkbook
Exit Function
End If
Next
Set getWorkbookByName = Nothing
End Function'########################################################################
'Excel Application の Object を作成する
'########################################################################
Private Sub SetExlObject()
On Error Resume Next
Set objExl = GetObject(, "Excel.Application")
If Err.Number > 0 Then
Set objExl = CreateObject("Excel.Application")
Err.Clear
End If
objExl.Visible = True
objExl.UserControl = True
End Sub
'########################################################################
'データー書き込み処理
'########################################################################
Private Sub WriteData(aWS As Object)
Dim lastrow As String
With aWS
nextrow = .Range("A" & 1000).End(xlUp).Row + 1
.Range("$A$" & nextrow).Value = "hoge" & nextrow
.Range("$A$" & nextrow).Value = "hogehoge" & nextrowEnd With
End Sub
エクセルファイルが開いている、開いていない判定処理
肝の部分はこちらです！
こちらのページを参考にさせて頂きました。
objExl.Worksheets で、開いているエクセルファイルのリストを取得し、For Each でループ処理し、引数のファイル名があるか、ないかをチェックします。
あれば、ファイルを開いていると判断し、ワークブックのオブジェクトを返し、なければ開いていないと判断して Nothing を返します。
'########################################################################
'指定のExcelファイルがある場合はオブジェクトを返し、無ければNothingを返す
'########################################################################
Private Function getWorkbookByName(targetWorkbookName) As Workbook
Dim TempWorkbook As Workbook
For Each TempWorkbook In objExl.Workbooks
If TempWorkbook.Name = targetWorkbookName Then
Set getWorkbookByName = TempWorkbook
Exit Function
End If
Next
Set getWorkbookByName = Nothing
End Function
ファイル処理部分に戻って
オブジェクトがNothing であれば、新規にエクセルオブジェクトを取得、そうでなければオブジェクトのコピーをSet します。
上記の処理により取得したワークブックオブジェクトからワークシートのオブジェクトを取得します。
'CSVファイルが開いていなければ、ファイルのオブジェクト取得
If tgtWB Is Nothing Then
Set srcWB = objExl.Workbooks.Open(ExpFileName)
'CSV開いていれば、開いているファイルのオブジェクトを取得
Else
Set srcWB = tgtWB
blFopen = True
End If
'ワークシートの取得
Set srcWS = srcWB.Worksheets(1)
最後は、ファイルデーター作成処理をして保存ですが、ここでエラーが発生してしまいました！
エラーコードは出てこないので、内容はわかりませんが、エラーとして取り扱われているようです。
ここは、強引な力技で、エラーをキャッチして何もしないという処理で乗り切りました！
このエラーが何なのかは追求しませんでした。
'データーの初期化処理 初めてファイルを開いた時
If blFopen = False Then
Call AllClear_Data(srcWS, ExpFile, ExpDRange)
End If
'データー書き込み処理
Call WriteData(srcWS)
On Error GoTo Exception
srcWB.Save
Exception:
'MsgBox Err.Number & "/" & Err.Description
Exit Sub
End Sub
まとめ
ファイルの開いている、開いていない判定はこのやり方じゃなくてもできそうな気はしますが、うまいやり方だなと参考になったので真似させて頂きました。
エラー処理の部分は力技ですね。
本当はもっとうまいやり方があるかもしれませんが、これで実用しました。
