vb如何往另一台计算机的共享文件夹里面添加文件,VB爱好者乐园(VBGood)

我用VB6做了一个程序，将本地的文件拷贝到局域网中共享目录中，方法是先上传文件，取得本地的文件路径到文本框中，然后通过fso.CopyFile 将文件拷贝，但是有一个问题就是，若事先没有登陆过目的网络机，那么就会出现错误，若事先访问过目的网络机，就可以拷贝，我觉得应当是因为我的服务器是设定有登陆密码，没有开GUEST用户，就出现了这个问题，但我不知怎么在VB中解决，请大家帮忙，下面是上传附件文件的代码。

谢谢

Private Function upfile() As Boolean  '上传附件

On Error GoTo errL

upfile = False

If Saddfile.Text <> "" Then

addfileContent = ""

Dim dm As Long

Dim arrf() As String

Dim fso As New FileSystemObject

Dim fstr As String

Dim strcopyto As String

Dim thefile As File

Dim oldfileName, newFileName As String

fstr = fso.BuildPath(getfilePath, loginUser) '取得用户存放附件目录

Dim sql As String

sql = ""

If fso.FolderExists(fstr) = True Then '如果此用户的目录已经存在

arrf = Split(Saddfile.Text, "|")

For dm = 0 To UBound(arrf)

Set thefile = fso.getfile(arrf(dm)) '取得上传文件的文件路径，包括文件名

oldfileName = thefile.Name '老文件名，就是没有更改前的名称

newFileName = Year(Date) & Month(Date) & Day(Date) & Hour(Time) & Minute(Time) & Second(Time) & GetExtension(arrf(dm)) '取要保存的新文件名

strcopyto = fso.BuildPath(fstr, newFileName) '最终保存文件路径与名称

fso.CopyFile arrf(dm), strcopyto, True

sql = sql & " insert into hm_emailadd(eid,filepath,ofilename,afilename) values('" & EmailID & "','" & strcopyto & "','" & oldfileName & "','" & newFileName & "')"

' MsgBox Sql

If addfileContent = "" Then

addfileContent = strcopyto

Else

addfileContent = addfileContent & "|" & strcopyto

End If

' MsgBox oldfileName & "|" & newFileName & "\" & strcopyto & "\" & arrf(dm)

Next dm

Else

fso.CreateFolder fstr '建立一个目录

arrf = Split(Saddfile.Text, "|")

For dm = 0 To UBound(arrf)

Set thefile = fso.getfile(arrf(dm)) '取得上传文件的文件路径，包括文件名

oldfileName = thefile.Name '老文件名，就是没有更改前的名称

newFileName = Year(Date) & Month(Date) & Day(Date) & Hour(Time) & Minute(Time) & Second(Time) & GetExtension(arrf(dm)) '取要保存的新文件名

strcopyto = fso.BuildPath(fstr, newFileName) '最终保存文件路径与名称

fso.CopyFile arrf(dm), strcopyto, True

sql = sql & " insert into hm_emailadd(eid,filepath,ofilename,afilename) values('" & EmailID & "','" & strcopyto & "','" & oldfileName & "','" & newFileName & "')"

If addfileContent = "" Then

addfileContent = strcopyto

Else

addfileContent = addfileContent & "|" & strcopyto

End If

'MsgBox oldfileName & "|" & newFileName & "|" & strcopyto & "|" & arrf(dm)

Next dm

End If

End If

If Len(sql) > 0 Then

'Dim sss As String

'sss = InputBox("", "", SQL)

Set rs = email_conn.Execute(sql)

End If

upfile = True

Exit Function

errL:

upfile = False

MsgBox Err.Description, vbCritical

Err.Clear

End Function