\\PCHのネットワークパソコンが共有しているフォルダを抽出するものですが。

\\PCHのネットワークパソコンが、ユーザー名、パスワードを入力しないと入れない場合に、
下のプログラムを起動すると
For k = 1 To UBound(ans)にて
オブジェクト変数またはWITHブロック変数が設定されていません。
と言うエラーが出ます。

On Error Resume Nextを入れるとこのエラーが出たり、出なかったりする感じがします。
どうすれば良いかを教えて下さい。


Public pc_fn(100)

Sub abc()
Dim k
'On Error GoTo 0
On Error Resume Next
                ans = pathfind("\\PCH", 0) '共有している最上位のフォルダのみ取得
                For k = 1 To UBound(ans)
                    If ans(k) = "" Then Exit For
                    pc_fn(k) = ans(k)
                    Debug.Print "test=", pc_fn(k)
                Next k
                MsgBox "end"    
End Sub


'マシン名を指定して共有フォルダを取得する。
Function pathfind(ByVal path As Variant, Optional ByVal lebel As Long = -1, Optional ByVal nest As Long = 0)
    Static pathnm()
    Static pidx As Long
    Static myshell As Object
    Dim fol As Object
    Dim fl As Object
    Dim g0 As Long
    On Error GoTo 0
    'On Error Resume Next 'アクセス出来ないパソコンがいる。
    If nest = 0 Then
       Erase pathnm()
       Set myshell = CreateObject("Shell.Application")
       pidx = 0
    End If
    With myshell
       Set fol = .Namespace(path)
       For Each fl In fol.items
          If fl.IsFileSystem And fl.IsFolder Then
             ReDim Preserve pathnm(1 To pidx + 1)
             pathnm(pidx + 1) = fl.path
             pidx = pidx + 1
             If lebel = -1 Or nest + 1 <= lebel Then pathfind fl.path, lebel, nest + 1
          End If
       Next
    End With
    If nest = 0 Then
       Set myshell = Nothing
       pathfind = pathnm()
       Erase pathnm()
       pidx = 0
    End If
    Set fol = Nothing
    Set fl = Nothing
End Function

> On Error Resume Nextを入れるとこのエラーが出たり、出なかったりする感じがします。
> どうすれば良いかを教えて下さい。

ごっそり書き換えて良いのなら、NetShareEnum API を
Level1 で呼び出して、SHARE_INFO_1 を受け取る形にすれば良いかと。

魔界の仮面弁士さんどうも有り難う御座います。

NetShareEnum APIなる物が調べる能力がありませんでした。
他に調べてみましたら、以下の物見つかりまして、
パソコンによっては取得出来るのですが、

殆どのパソコンで
オートメーションエラーです。
グループ名が見つかりません。
とエラーします。
と言うエラーが出ます。
ちんぷんかんぷんで申し訳ないのですが、
教えて下さい。

Private Sub Command1_Click()
    Dim FileService As IADsFileService
    Dim FileShare As IADsFileShare
    Dim ComputerName As String
    List3.Clear
    ComputerName = "PC0"
    Set FileService = GetObject("WinNT://" & ComputerName & "/LanmanServer")

    If FileService.Class = "FileService" Then
        For Each FileShare In FileService
            If Right$(FileShare.Name, 1) <> "$" Then
                List3.AddItem FileShare.Name
                'Debug.Print FileShare.Path
            End If
        Next
    End If
End Sub

> NetShareEnum APIなる物が調べる能力がありませんでした。
> 他に調べてみましたら、以下の物見つかりまして、
> パソコンによっては取得出来るのですが、

その方法だと、取得できない環境が出てきますので、
NetShareEnum を使った方法をおすすめします。


http://www.vbstation.net/spec/S2_6.htm
たとえば上記は、VB6 から NetShareEnum を呼ぶサンプルです。

サンプル中では、情報レベル502 を指定していますが、これだと権限不足で
弾かれてしまう可能性が高いので、取得する情報をレベル1まで落としてください。

具体的には、サンプル中の NetShareEnum を呼び出すところで、
「ByVal 502」→「ByVal 1」に変更するということです。また、同様に
「tSI502(0).shi502_netname」→「tSI1(0).shi1_netname」などについても
書き換えてやれば、動作するようになると思います。


ただし、このサンプルでは Unicode 文字列の扱い方に問題があるので、
その点も見直す必要があります。
http://hanatyan.sakura.ne.jp/vb60bbs/wforum.cgi?mode=allread&no=11192&page=0

魔界の仮面弁士さんご回答大変有り難う御座います。
> http://www.vbstation.net/spec/S2_6.htm
サンプルダウンロードして取得する情報をレベル1まで落とす作業
多分出来たのではないかと思います。
多分と言うのは、殆ど理解出来ないまま、tSI502(0)→tSI1(0)等への変換して
偶然にもエラーが無くなり実行出来ました。
リストボックスに表示取得出来たのは、LANdisk、win7パソコン
何故かwinxpのパソコンが認識出来ず、
[5532]でハンドルされていないwin32の例外が発生しました。
と言うエラーが出力されるか、突然このパソコンを選択するとプログラムが終了します。

Unicode文字列の扱い方の事ですが、これがまたわからないのですが。
取得した情報が確かに???で表示されている物があります。
NetShareGetInfoの部分を抜き出したのですが、置き換え方法がわからないのですが、
教えて頂く事出来ますでしょうか。大変お手数おかけします。

    ShareGetInfo502 = NetShareGetInfo(StrConv(strNetShareServer, vbUnicode), _
                                      StrConv(strShareName, vbUnicode), _
                                      502, _
                                      lngBuffer)
Private Declare Function NetShareGetInfo Lib "netapi32.dll" (ByVal servername As String, _
                                                             ByVal netname As String, _
                                                             ByVal level As Long, _
                                                             bufptr As Any) As Long
    ShareGetInfo2 = NetShareGetInfo(StrConv(strNetShareServer, vbUnicode), _
                                    StrConv(strShareName, vbUnicode), _
                                    2, _
                                    lngBuffer)

> Unicode文字列の扱い方の事ですが、これがまたわからないのですが。
Declare の際に、ByVal String として宣言されていますが、
それを ByRef Byte にしてみてください。

呼び出す側では、文字列をバイト配列に変換してから、
その配列の先頭要素を API に渡すようにします。


> NetShareGetInfoの部分を抜き出したのですが、置き換え方法がわからないのですが、
…NetShareEnum ではなく? まぁ、そちらを望むのであればそちらで答えますけれども。


NetShareEnum にサーバー名を渡すと、共有情報が得られます。
NetShareGetInfo にサーバー名と共有名を渡すと、その共有資源の情報を得られます。



具体的には、こんな感じで。

> Private Declare Function NetShareGetInfo Lib "netapi32.dll" ( _
>    ByVal servername As String, _
>    ByVal netname As String, _
>    ByVal level As Long, _
>    bufptr As Any) As Long

  Private Declare Function NetShareGetInfo Lib "netapi32.dll" ( _
     ByRef servername As Byte, _
     ByRef netname As Byte, _
     ByVal level As Long, _
     ByRef bufptr As Any) As Long


> ShareGetInfo502 = NetShareGetInfo(StrConv(strNetShareServer, vbUnicode), _
>                                   StrConv(strShareName, vbUnicode), _
>                                   502, _
>                                   lngBuffer)
> ShareGetInfo2   = NetShareGetInfo(StrConv(strNetShareServer, vbUnicode), _
>                                   StrConv(strShareName, vbUnicode), _
>                                   2, _
>                                   lngBuffer)

  Dim binNetShareServer() As Byte
  binNetShareServer = strNetShareServer & vbNullChar
  Dim binShareName() As Byte
  binShareName = strShareName & vbNullChar
  ShareGetInfo1 = NetShareGetInfo(binNetShareServer(0), _
                                  binShareName(0), _
                                  1, _
                                  lngBuffer)


NetShareEnum にしても NetShareGetInfo にしても、取得する情報レベルを
指定できるようになっています。レベル 0 では、共有名しか得られませんが、
レベルが高くなるにつれて、より多くの情報を得る事ができます。

その反面、多くの情報を得るためには、管理者級の高いアクセス権を必要とします。
限定された情報のみ得るのであれば、特別なグループメンバーシップは必要ありません。


今回は \\PCH のフォルダ共有名のみ得られれば良いのでしょうから、
NetShareEnum の レベル1 で良いかと思います。
レベル0 でも良いのですが、これだと名前しか分からないので、
共有フォルダなのか共有プリンタなのか判断できませんしね。


≪情報レベル≫API/OS/接続先等によって、指定可能なレベルが異なります。

・9x系(98, ME等)
レベル1: 共有名、種類、コメント
レベル50: 共有名、種類、アクセス権、コメント、パス、パスワード、書込パスワード、読取パスワード

・NT系(XP, Vista等)
レベル0: 共有名
レベル1: 共有名、種類、コメント
レベル2: 共有名、種類、アクセス許可、最大接続数、現接続数、パス、パスワード
レベル501: 共有名、種類、コメント
レベル502: 共有名、種類、アクセス許可、最大接続数、現接続数、パス、パスワード、セキュリティ記述子
レベル503: 共有名、種類、アクセス許可、最大接続数、現接続数、パス、パスワード、サーバー名、セキュリティ記述子
レベル1004: コメント
レベル1005: DFSルート内のDFSリンクか否か
レベル1005: 最大接続数
レベル1501: セキュリティ記述子