Inhaltsverzeichnis von Sharepoint-Verzeichnissen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Stefan,
dazu muss man meines Wissens zuerst das SharePoint-Verzeichnis als Netzlaufwerk Mappen.
Anbei ein (ungetestetes) Beispiel.

' **********************************************************************
' Modul: Modul5  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit
'src:=http://www.vbarchiv.net/tipps/tipp_330-netzlaufwerk-verbinden-und-trennen.html
Private Declare Function WNetAddConnection Lib "mpr.dll" Alias "WNetAddConnectionA" (ByVal _
  lpszNetPath As String, ByVal lpszPassword As String, ByVal lpszLocalName As String) As Long

Private Declare Function WNetCancelConnection Lib "mpr.dll" Alias "WNetCancelConnectionA" (ByVal _
  lpszName As String, ByVal bForce As Long) As Long

Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" _
  (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

' Fehler-/Rückgabe-Konstanten
Private Const WN_SUCCESS = 0
Private Const WN_NET_ERROR = 2
Private Const WN_BAD_PASSWORD = 6


Sub beispiel()
  Dim LocalDrive As String, RemoteDrive As String
  Dim strRoot As String
  
  'SharePoint-Adresse
  RemoteDrive = "https://collaboration.intranet.fima.com/team/ex/"
  
  'Freien Laufwerksbuchstaben ermitteln
  LocalDrive = GetFreeLocalDrive()
  
  'Netzlaufwerk verbinden
  If Drive_Connect(LocalDrive, RemoteDrive, True) Then
    
    strRoot = LocalDrive & "\"
    'hier dein Code mit strRoot als Ausgangspunkt!
    
    
    
    'Netzlaufwerk trennen
    Drive_Disconnect LocalDrive, False
  End If
  
End Sub


Public Function Drive_Connect(ByVal LocalDrive As String, _
    ByVal NetworkPath As String, _
    Optional ByVal ShowError As Boolean = False) As Boolean
  
  Dim lResult As Long
  
  lResult = WNetAddConnection(NetworkPath, _
    vbNullString, LocalDrive)
  
  If ShowError And lResult <> WN_SUCCESS Then
    If lResult = WN_NET_ERROR Then
      MsgBox "Netzwerkfehler!"
    ElseIf lResult = WN_BAD_PASSWORD Then
      MsgBox "Ungültiges Passwort!"
    Else
      MsgBox "Unbekannter Fehler"
    End If
  End If
  
  Drive_Connect = (lResult = WN_SUCCESS)
End Function


Private Function Drive_Disconnect( _
    ByVal LocalDrive As String, _
    Optional ByVal ShowError As Boolean = False) As Boolean
  
  Dim lResult As Long
  
  lResult = WNetCancelConnection(LocalDrive, True)
  
  If ShowError And lResult <> WN_SUCCESS Then
    If lResult = WN_NET_ERROR Then
      MsgBox "Netzwerkfehler!"
    ElseIf lResult = WN_BAD_PASSWORD Then
      MsgBox "Ungültiges Passwort!"
    Else
      MsgBox "Unbekannter Fehler"
    End If
  End If
  
  Drive_Disconnect = (lResult = WN_SUCCESS)
End Function


Public Function GetFreeLocalDrive() As String
  Dim sBuffer As String * 255
  Dim sDrives As String
  Dim lResult As Long
  Dim sDrive As String
  Dim sPos As Integer
  Dim LogicalDrive(25) As String
  Dim I As Integer
  
  ' Laufwerksbuchstaben A: - Z:
  For I = 0 To 25
    LogicalDrive(I) = Chr$(65 + I) + ":"
  Next I
  
  ' zunächst alle belegten Laufwerksbuchstaben ermitteln
  lResult = GetLogicalDriveStrings(Len(sBuffer), sBuffer)
  sDrives = Left$(sBuffer, lResult)
  
  While Len(sDrives) > 0
    sPos = InStr(sDrives, Chr$(0))
    sDrive = Left$(sDrives, sPos - 1)
    sDrives = Mid$(sDrives, sPos + 1)
    
    ' Aus dem Array "streichen"
    LogicalDrive(Asc(Left$(sDrive, 1)) - 65) = ""
  Wend
  
  For I = 3 To 25
    If LogicalDrive(I) <> "" Then
      ' erster freier Laufwerksbuchstabe
      GetFreeLocalDrive = LogicalDrive(I)
      Exit For
    End If
  Next I
End Function

« Gruß Sepp »

Beliebteste Forumthreads (12 Monate)

Inhaltsverzeichnis von Sharepoint-Verzeichnissen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread