VBAで、ファイルサーバーにユーザIDとパスワードを用いてログインする方法

Question

VBAでフォームのボタンをクリックしたら、このVBAが乗っているExcelと同一フォルダー内のCSVファイルを\192.168.1.39\bfにコピーするというコードです。

Private Sub CommandButton3_Click()
   Dim strDirectory As String
   strDirectory = "\192.168.1.39\bf"　　　'共有ファイルパス
   Shell ("net use " & strDirectory & " test /user:test")  'パスワード /ユーザー
 　FileCopy ThisWorkbook.Path & "\abc.csv", "\192.168.1.39\bf\abc.csv"
   Shell ("net use " & strDirectory & " /delete")
   End
End Sub

パスワード付きのファイルサーバのファイル移動などを調べて見本コードを参考に作ってみましたが、FileCopy ThisWorkbook.Path & "\abc.csv", "\192.168.1.39\bf\abc.csv"　で下記の画像のエラーが発生します

![]

※IPアドレスは見本です。

FileCopy ThisWorkbook.Path & "\abc.csv", "\192.168.1.39\bf\abc.csv"　このコードを単体で、FileCopy ThisWorkbook.Path & "\abc.csv", "C:\Users\Documents\abc.csv"にしてローカルでは動作します。

Excel 2016
win10

Comments

[tosi]

フォルダの一覧を表示して、ネットのdfが間違い無く接続しているか、確認されたらどうですか。
Dim strFolder As String
strFolder = Dir("\\192.168.1.39\bf\", vbDirectory)
Do While Len(strFolder) > 0
Debug.Print strFolder
strFolder = Dir()
Loop

[Y.H.]

net use \\192.168.1.39\bf test /user:test
をコマンドプロンプトから実行した場合、エラー無く終了しますか？

[tosi]

>エラー無く終了しますか？
間違っていたら、当然にエラーでます。
多分、Net Useコマンドが完了する前に、コピー動いていると思います。
この時には、フォルダ一覧も表示されません。
F8でゆっくりとステップさせると、時間差で正常に動いたりもします。
回答欄へ完了までの待合せソースを載せました。

[Y.H.]

@tosi
tosiさんへではなく 質問者さん(Ti1234565) への問いかけでした。

Answer 1

解決しました。
strDirectory = "\192.168.1.39\bf"　　　'共有ファイルパス
ここを\192.168.1.39 にしました。
net use のすぐあとにコピーではなく、、3秒待たせました

Answer 2

環境Excel2010/32Bit

Private Declare Function OpenProcess Lib "kernel32" _
    (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
     ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" _
    (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" _
    (ByVal hObject As Long) As Long
Private Const PROCESS_QUERY_INFORMATION = &H400&
Private Const STILL_ACTIVE = &H103&

Private Sub CommandButton3_Click()
   Dim strDirectory As String
   Dim Result As Long
   strDirectory = "\192.168.1.39\bf"　　　'共有ファイルパス
   Result = Shell ("net use " & strDirectory & " test /user:test")  'パスワード /ユーザー
    If Result = 0 Then
        MsgBox "Error=" & Result: Exit Sub
    Else
        '接続完了まで待合せ
        Dim hProcess As Long
        Dim EndCode As Long
        Dim EndRet   As Long
        hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 1, Result)
        Do
            Debug.Print "Wait:" & EndRet
            EndRet = GetExitCodeProcess(hProcess, EndCode)
            DoEvents
        Loop While (EndCode = STILL_ACTIVE)
        EndRet = CloseHandle(hProcess)
    End If

 　FileCopy ThisWorkbook.Path & "\abc.csv", "\192.168.1.39\bf\abc.csv"
   Shell ("net use " & strDirectory & " /delete")
   End
End Sub