「Web出版サイト」ベータ公開

Q&A集[?]

当サイトでのご質問の受付は終了しました

すべてのコンテンツを読み込み専用としたため、回答欄からも投稿できません

Apache OpenOffice/LibreOfficeのご質問はそれぞれのフォーラムへご投稿ください

質問コーナー

サイト内検索

分類メニュー

関連サイト


本日:1
昨日:1
総数:2549
現在:5


ネットワーク接続について

ページOpenOffice.org FAQの登録ページ
投稿者タイガー
分類
edit/refer
優先順位
edit/refer
状態
edit/refer
カテゴリー
edit/refer
投稿日2010-12-13 15:43:27 (月)
OSWin XP
依存するページ
バージョン
edit/refer

メッセージ

回答ページでは行末に「~」を付加する必要はありません

お世話になります。 ネットワークに接続する方法についてですが、 エクセル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がそのまま動くかどうか

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」に変えても実行結果に変化はありませんでした。

同じ結果でした

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

有難う御座いました

タイガー (2010-12-17 14:27:02 (金))

当初のやり方では、「487」のエラーが出ておりましたが、
ike@九州さんのWScript.Networkを使えば見事!!
上手くできました。
有難う御座いました

お名前:
題名: