* ネットワーク接続について [#bf619546]
 |RIGHT:|LEFT:|c
 |~ページ|[[OpenOffice.org FAQの登録ページ]]|
 |~投稿者|タイガー|
 |~分類|#listbox3(Q&A,faq03,class)|
 |~優先順位|#listbox3(重要,faq03,priority)|
 |~状態|#listbox3(完了,faq03,state)|
 |~カテゴリー|#listbox3(その他,faq03,category)|
 |~投稿日|2010-12-13 15:43:27 (月)|
 |~OS|Win XP|
 |~依存するページ||
 |~バージョン|#listbox3(3.2.1,faq03,version)|
 
 ** メッセージ [#sb7ce658]
 |LEFT:|c
 |回答ページでは行末に「~」を付加する必要はありません|
 お世話になります。
 ネットワークに接続する方法についてですが、
 エクセルVBAでは、問題なく接続できるのですが
 OOoBasicで実行したら、から移植したいのですが、原因不明になります。
 どこがおかしいのでしょうか?
 アドバイスお願いいたします。
 
 
  Private Declare Function WNetAddConnection3 Lib "mpr.dll" Alias "WNetAddConnection3A" _
     (ByVal hWndOwner As Long, lpNetResource As NETRESOURCE, _
      ByVal lpPassword As String, ByVal lpUserName As String, ByVal dwFlags As Long) As Long
  
  Type NETRESOURCE
         dwScope As Long
         dwType As Long
         dwDisplayType As Long
         dwUsage As Long
         lpLocalName As String
         lpRemoteName As String
         lpComment As String
         lpProvider As String
  End Type
  
  Private Const CONNECT_INTERACTIVE = &H8
  Private Const RESOURCETYPE_DISK = &H1
  Private Const CONNECT_USAGE = &H1
  
  Sub Test()
     Dim ns As NETRESOURCE
     Dim user As String
     Dim pass As String
     Dim st As Long
     Dim m_F As Boolean
     Dim m_str As String
     Dim mPath As String
     
     mPath = ""   '\\で始まるアドレスを指定
     user = ""    'ユーザー名を指定
     pass = ""    'パスワードを指定
     
     With ns
         .dwUsage = CONNECT_USAGE
         .dwType = RESOURCETYPE_DISK
         .lpRemoteName = mPath
         .lpLocalName = "Z:"
         .lpProvider = vbNullString
         .lpComment = vbNullString
     End With
     
     st = WNetAddConnection3(&H0, ns, pass, user, CONNECT_INTERACTIVE)
     
     Select Case st
         Case 0&
             m_F = True
         Case 53&
             m_str = "ネットワークサーバが見つかりません"
         Case 67&
             m_str = "ネットワークパスが見つかりません(共有になっていません)"
         Case 85&
             m_F = True
         Case Else
             m_str = "原因不明、ネットワークに出来ませんでした."
     End Select
     Print st
  End Sub
 
 ----
 ***Windows APIがそのまま動くかどうか [#fa537caf]
 >M.Kamataki (2010-12-14 12:32:06 (火))~
 ~
 VBAでのWindows APIのWNetAddConnection3関数を利用した例は以下などにサンプルがあります。~
 ~
 http://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=36579;id=excel~
 ~
 お示しのコードを試してみると、OpenOffice.orgでもそれなりに動くようですが、果たして機能しているかどうかはわかりませんね。~
 ~
 ちなみにメッセージボックスは「487」、mPathに共有フォルダを指定した場合は、「1200」が返ってきました。とりあえず試してみた結果です。~
 ~
 なお、以下の英語のフォーラムにWindows APIに関する質問がありました。~
 ~
 How do I call Windows API methods from OO Basic?~
 http://www.oooforum.org/forum/viewtopic.phtml?t=60263~
 ~
 ここに書いてあるように「ByVal」を「ByRef」に変えても実行結果に変化はありませんでした。~
 
 //
 ***同じ結果でした [#j34d334d]
 >ike@九州 (2010-12-14 13:04:15 (火))~
 ~
 Kamataki さん同様でした。~
 どうも、Type〜End Type で定義したものが正しく渡されていないような気がします。~
 ~
 他に方法があるかもしれないという事で調べてみました。~
 http://www.atmarkit.co.jp/fwin2k/operation/wsh08/wsh08_02.html~
 接続先が WindowsPC のみ確認済。~
  Sub CreateNetworkDrive
   mPath = "\\VISTA\WORK"   '\\で始まるアドレスを指定
   slocalName = "Z:"
   user = "hoge"    'ユーザー名を指定
   pass = "hogehoge"    'パスワードを指定
   
   FS = CreateObject( "Scripting.FileSystemObject" )  
   WshNetwork = CreateObject( "WScript.Network" )
   cDrives = WshNetwork.EnumNetworkDrives
   
   IF cDrives.Count >0 Then
    
    For i = 0 to  cDrives.Count - 1 Step 2
      'ネットワークドライブの既存確認
      IF StrComp( cDrives.Item(i), slocalName, 1 )  = 0 then
        'ネットワークドライブの接続先確認
        IF StrComp( cDrives.Item (i + 1) ,mPath ,1 ) = 0 Then
         WshNetwork.RemoveNetworkDrive( cDrives.Item(i),true,true )
        Else       
          '接続先が違う同じネットワークドライブ名の場合
          IF MsgBox(cDrives.Item(i) & "  (" & cDrives.Item(i+1) & ")"  & _
          " が存在します" & Chr(13) & "削除して" & CHR(13) & _
          slocalName & " (" & mPath & ") を作成しますか",4) =  6 Then
            WshNetwork.RemoveNetworkDrive( cDrives.Item(i),true,true)
          Else
            Exit Sub 
          End IF        
        End IF  
      End IF
    Next
    
   End IF
   
   On Error  Resume Next
   'ネットワークドライブ作成
   WshNetwork.MapNetworkDrive( slocalName, mPath, False, user, pass )
   On Error Goto 0
   cDrives = WshNetwork.EnumNetworkDrives
   
   IF cDrives.Count > 0 Then
    For i = 0 to cDrives.Count -1 Step 2
      IF StrComp( cDrives.Item(i), slocalName, 1 )  = 0 then
         IF Not FS.FolderExists(mPath) Then
           MsgBox("接続不可" &  Chr(13) & "ユーザー名 が間違っている可能性があります")
           WshNetwork.RemoveNetworkDrive cDrives.Item(i)
         Else
           oShell = CreateObject("Shell.Application")
           oShell.NameSpace("Z:\").Items().Item.Name = mPath
           Msgbox("正常に作成しました")  
         End IF
         Exit Sub
      End IF    
    Next
   End IF 
   MsgBox("接続不可" & Chr(13) & "パスワード間違い 又は 共有不可の可能性があります")
  End Sub
 #動作を煮詰め修正しました。m(_ _)m~
 
 //
 ***有難う御座いました [#z03613ad]
 >タイガー (2010-12-17 14:27:02 (金))~
 ~
 当初のやり方では、「487」のエラーが出ておりましたが、~
 ike@九州さんのWScript.Networkを使えば見事!!~
 上手くできました。~
 有難う御座いました~
 
 //
 #article