Type mismatch when copy empty cell to Access database

[Angus]

I got a code to write data from Excel to Access database, but got a "Type
mismatch" when copy cell B2 to "Dispatch_date" field in database, if B2 is
empty. The setting of "dispatch_date" in database requires no input. Please
help.

Sub ADOWritedata()

Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long

Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=C:\Documents and
Settings\zi38610\Desktop\MIQ\Data\MIQ.mdb;"

Set rs = New ADODB.Recordset
rs.Open "Billing_Port_Forwarder_Charge", cn, adOpenKeyset,
adLockOptimistic, adCmdTable

r = 2 ' the start row in the worksheet
Do While Len(Range("A" & r).Formula) > 0
With rs
.AddNew ' create a new record
.Fields("Deal_number") = Trim(Range("A" & r).Value)
.Fields("Dispatch_date") = Trim(Range("B" & r).Value)
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub

 

[Tom Ogilvy]

Sub ADOWritedata()

Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long

Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=C:\Documents and
Settings\zi38610\Desktop\MIQ\Data\MIQ.mdb;"

Set rs = New ADODB.Recordset
rs.Open "Billing_Port_Forwarder_Charge", cn, adOpenKeyset,
adLockOptimistic, adCmdTable

r = 2 ' the start row in the worksheet
Do While Len(Range("A" & r).Formula) > 0
With rs
.AddNew ' create a new record
.Fields("Deal_number") = Trim(Range("A" & r).Value)
if len(trim(Range("B" & r).Text)) > 0 then _
.Fields("Dispatch_date") = Trim(Range("B" & r).Value)
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub