Excel Vba 実行時エラー’-2147352571(80020005)': 種類が一致しません。
解決したいこと
Excel Vba 実行時エラー’-2147352571(80020005)': 種類が一致しません。
何故か下記のコードのポイントで詰まります
エラーのコード
.Fields("作業日").Value = Range("H1")
解決方法を教えて下さい。
該当するソースコード
Private Sub CommandButton2_Click()
Dim con As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim conStr As String
conStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ActiveWorkbook.Path & "\電子チェックシートDB_S.accdb"
con.Open ConnectionString:=conStr
rs.Open Source:="T_ED_DS_Between", ActiveConnection:=con, _
CursorType:=adOpenKeyset, LockType:=adLockOptimistic
If Range("B1") = "" Or _
Range("B2") = "" Then
MsgBox "ED_DSが入力されていません"
Exit Sub
End If
Range("F37") = Format(Time, "hh:mm:ss")
If Range("G38") = "" Then
Range("G38") = Format(Range("F37") - Range("E37"), "hh:mm:ss")
Else
Range("G38") = Format(Range("F37") - Range("E38") + Range("G38"), "hh:mm:ss")
End If
'--------------------------------Excel出力--------------------------------
Dim FileName As String
FileName = "********************" & Range("B2") & Range("F37") & ".xlsm" 'ファイル名作成
If MsgBox(Range("B1") & "_" & Range("B2") & ".xlsm" & " で保存しますか？", vbYesNo) <> vbYes Then Exit Sub '保存するか確認して保存しない場合は終了
Application.DisplayAlerts = False '同名のファイルがある場合の警告禁止(必要なら)
ActiveSheet.SaveAs FileName
'From:=1, To:=2
Set fso = Nothing
Application.DisplayAlerts = True '警告許可(上で警告禁止した場合は警告許可に戻す)
Dim i As Integer
With rs
.AddNew
.Fields("ED").Value = Range("B1")
.Fields("DS").Value = Range("B2")
.Fields("ファイル").Value = "#" & FileName & "#"
.Fields("In").Value = Range("E37")
.Fields("Out").Value = Range("F37")
'.Fields("Time").Value = Range("G37")
.Fields("作業日").Value = Range("H1")
.Update
End With
rs.Close
con.Close
MsgBox "お疲れ様でした"
End Sub
0 likes
