我自己用的向U盘追加传送数据的一个函数，不知道能不能帮到你！
Function toUpan()
On Error GoTo ErrorHandler
Dim ss As Integer
Dim fn As String
Dim pan As String
Dim StrDrive As String
Dim StrDriveArray() As String
Dim d As Object
Dim StartPos As Integer
Dim fs As Object
Dim IsNo As Boolean
Dim dName As String
Dim varResult As String
Dim dbs As Database, rst As Recordset
Dim getID As String
fn = "UMwzl004\Data.mdb"
On Error Resume Next
Set fs = CreateObject("Scripting.FileSystemObject")
StrDrive = "B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z"
StrDriveArray = Split(StrDrive, ",")
For StartPos = 1 To UBound(StrDriveArray)
Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName(StrDriveArray(StartPos) & ":\\")))
If d.DriveType = 1 Then
If d.SerialNumber = "1946631455" And Len(Dir(dName & ":\" & fn)) <> 0 Then '优盘、优盘号码正确、优盘内文件存在
IsNo = True
dName = d.DriveLetter
Exit For
End If
End If
Next
If IsNo = False Then
MsgBox "系统未检测到专用U盘！或者U盘内没有指定文件！"
Else
If MsgBox("你将上传数据ID号为" & Me.sfrList.Form!销售ID & "，确定后不能更改，请慎重！", vbYesNo, "数据上传到指定U盘窗体") = vbNo Then Exit Function
varResult = Nz(Me.sfrList.Form!货品去向, "无")
Set dbs = OpenDatabase(dName & ":\" & fn)
Set rst = dbs.OpenRecordset("货品销售明细表", dbOpenDynaset)
rst.MoveLast
MsgBox rst.RecordCount
getID = inserSet_getID1(dbs, Me.sfrList.Form!货品所在位置, Me.sfrList.Form!业务员, Me.sfrList.Form!销售时间, varResult)
CurrentDb.Execute "INSERT INTO " & dName & ":\" & fn & ".货品销售明细表" _
& "(销售ID,货品名称,规格,数量,金额,奖金,费用,结算方式,日志) SELECT " _
& getID & " AS 销售ID,货品名称 ,规格,数量 ,金额,奖金,费用,结算方式," _
& ff() & "& 日志 AS 表达式 FROM 货品销售明细表 where 销售ID=" & Me.sfrList.Form!销售ID
CurrentDb.Execute " UPDATE 货品销售表 SET 货品销售表.备注 = 货品销售表.备注& 'ok' where 销售ID=" & Me.sfrList.Form!销售ID
Me.sfrList.Form.Requery
MsgBox "上传完毕！"
End If
ExitHere:
Set dbs = Nothing
Set d = Nothing
Set fs = Nothing
Exit Function
ErrorHandler:
RDPErrorHandler Me.Name & ": 操作没有成功"
Resume ExitHere
Set dbs = Nothing
Set d = Nothing
Set fs = Nothing
End Function
