Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1412to1416
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Öffnen Dialog mit Sharepoint

Öffnen Dialog mit Sharepoint
09.03.2015 13:24:09
nike
Hi,
ja, nach Jahren der Abstinenz "verirre" ich mich auch mal wieder hier her :-)
Und dann seh ich auch glatt noch so altbekannte Namen wie Hajo Zi,
da wird einem doch glatt warm ums Herz ;-)
Ich hätte da ein kleines Problemchen, da ich meinen Uraltcode aus dem Jahr 2003
etwas aufbohren muss, damit nun auch das Öffnen von Dateien die auf dem Sharepoint liegen möglich wird.
Ich hab mir da schon was rausgesucht, das in anderer Kombi auch schon gut funktioniert hat - die Funktion Parse_Resource() die mir die URL in WEBDAV übersetzt...
Leider bekomme ich in meinem alten Code eine Fehlermeldung "Kein ByRef möglich"
Wäre nett, wenn sich einer erbarmt und mir nen Tip gibt.
Ciao
Nike

Sub Analyse()
Dim arrFilenames As Variant
Dim wbkArr As Workbook
Dim wbkBasis As Workbook
Set wbkBasis = ActiveWorkbook
Selection:
' Zu öffnende Dateien erfragen
arrFilenames = Application.GetOpenFilename( _
"Excelfiles (*.xlsm), *.xlsm, All Files (*.*), *.*", 1, _
"Select Excel files...", MultiSelect:=True)
'Add selected files to an array field
If VarType(arrFilenames) = vbBoolean Then
If MsgBox("No files were selected. Do you want to exit the Makro?", vbYesNo, "Exit?") =  _
_
vbNo Then
GoTo Selection
Else
Set wbkBasis = Nothing
Exit Sub
End If
End If
Application.ScreenUpdating = False
'Hide Makro activity to gain speed
For i = 1 To UBound(arrFilenames) ' Durchläuft die Anzahl der Dateien
'Wenn Datei noch nicht geöffnet
'If FileOpenYet(Dir$(arrFilenames(i))) = False Then
If FileOpenYet(Parse_Resource(arrFilenames(i))) = False Then
'dann öffnen
'Workbooks.Open FileName:=arrFilenames(i)
Workbooks.Open FileName:=Parse_Resource(arrFilenames(i))
Else
'oder Aktivieren
Workbooks(arrFilenames(i)).Activate
End If
Set wbkArr = ActiveWorkbook
'hier kommt dann der Code rein, der die ausgewählten Dateien
'betrifft. Die Ursprungsdatei ist über wbkBasis ansprechbar.
wkbbasis.Worksheets(1).Cells(i, 1) = wbkArr.Worksheets(1).Range("F32")
wkbbasis.Worksheets(1).Cells(i, 2) = wbkArr.Name
wbkArr.Close savechanges:=False    'Datei schließen
Set wbkArr = Nothing
Next i
Set wbkArr = Nothing
wbkBasis.Activate
Set wbkBasis = Nothing
Application.ScreenUpdating = True
End Sub
Function FileOpenYet(FileName As String) As Boolean
'eine Funktion, die Prüft ob eine Datei schon geöffnet ist.
Dim s As String
On Error GoTo Nonexistent
s = Workbooks(FileName).Name
FileOpenYet = True
Exit Function
Nonexistent:
FileOpenYet = False
End Function
Public Function Parse_Resource(URL As String)
'Uncomment the below line to test locally without calling the function & remove argument above
'Dim URL As String
Dim SplitURL() As String
Dim i As Integer
Dim WebDAVURI As String
'Check for a double forward slash in the resource path. This will indicate a URL
If Not InStr(1, URL, "//", vbBinaryCompare) = 0 Then
'Split the URL into an array so it can be analyzed & reused
SplitURL = Split(URL, "/", , vbBinaryCompare)
'URL has been found so prep the WebDAVURI string
WebDAVURI = "\\"
'Check if the URL is secure
If SplitURL(0) = "https:" Then
'The code iterates through the array excluding unneeded components of the URL
For i = 0 To UBound(SplitURL)
If Not SplitURL(i) = "" Then
Select Case i
Case 0
'Do nothing because we do not need the HTTPS element
Case 1
'Do nothing because this array slot is empty
Case 2
'This should be the root URL of the site. Add @ssl to the WebDAVURI
WebDAVURI = WebDAVURI & SplitURL(i) & "@ssl"
Case Else
'Append URI components and build string
WebDAVURI = WebDAVURI & "\" & SplitURL(i)
End Select
End If
Next i
Else
'URL is not secure
For i = 0 To UBound(SplitURL)
'The code iterates through the array excluding unneeded components of the URL
If Not SplitURL(i) = "" Then
Select Case i
Case 0
'Do nothing because we do not need the HTTPS element
Case 1
'Do nothing because this array slot is empty
Case 2
'This should be the root URL of the site. Does not require an additional  _
slash
WebDAVURI = WebDAVURI & SplitURL(i)
Case Else
'Append URI components and build string
WebDAVURI = WebDAVURI & "\" & SplitURL(i)
End Select
End If
Next i
End If
'Set the Parse_Resource value to WebDAVURI
Parse_Resource = WebDAVURI
Else
'There was no double forward slash so return system path as is
Parse_Resource = URL
End If
End Function

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

Betreff
Datum
Anwender
Anzeige
AW: Öffnen Dialog mit Sharepoint
09.03.2015 15:33:23
Nepumuk
Hallo,
setz die Parameter in Klammern, damit erzwingst du die Konvertierung vom Variant in einen String.
Gruß
Nepumuk

AW: Öffnen Dialog mit Sharepoint
10.03.2015 08:19:16
nike
Hi Nepumuk,
Du treibst Dich doch auch schon seit Jahr und Tag hier rum ;-)
Schon schön, wenn man ein paar alte Recken wieder sieht :-)
Der Tip hat funktioniert - danke Dir.
Ciao
Nike
Anzeige

73 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige