VBA - Excelmappe auf Sharepoint speichern

[wisch]

Hallo,

ich glaube, ich bin nun etwas brauchbares gefunden. Auf jeden Fall habe ich es damit tatsächlich geschafft, meine auf einem lokalen Laufwerk auf meinen Firmenlaptop befindliche Testmappe, in einem SharePpointverzeichnis zu speichern.


Nachfolgend der entsprechend Code.

PHP-Code:

Sub Push2SharePoint()

    ' define variables
    Dim SharePointPath As Variant
    Dim FileAsNamed As Variant
    ' retrieve SharePoint path indicated by the user inside Excel Sheet named "Select" on cell B33
    SharePointPath = ThisWorkbook.Sheets("Select").Range("B33").Text
    ' provide some error message if it's not populated
    On Error GoTo NoStorageSelected
    If Not SharePointPath <> False Then
        'Displaying a message if file not choosedn in the above step
        MsgBox "No storage space was selected.", vbExclamation, "Sorry!"
        'And existing from the procedure
        Exit Sub
    Else
        'Create the new file name, note we place data format in ISO 8601 format in front of the file name
        FileAsNamed = SharePointPath & Year(Date) & "-" & Month(Date) & "-" & Day(Date) & "_" & ThisWorkbook.Name

        ' save the copy
        ThisWorkbook.SaveAs FileName:=FileAsNamed, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False


    End If

Exit Sub
' Error Management
NoStorageSelected:
           MsgBox "Error: Excel can not reach SharePoint Folder Storage location" & vbCrLf & _
           "Possible reasons are: Storage location was not defined in the Worksheet 'Select' cell B33 or " & vbCrLf & _
           "Not having sufficient previledges to access SharePoint location " & vbCrLf & _
           "Make sure to add forward slash after SharePoint Document Library"
           Exit Sub

End Sub 


Nur wenn ich die Zeile:

Code:

       ThisWorkbook.SaveAs FileName:=FileAsNamed, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

durch

Code:

       ThisWorkbook.SaveCopyAs FileName:=FileAsNamed, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

oder

Code:

       ThisWorkbook.SaveCopyAs FileName:=FileAsNamed

ersetzten will, erhalte ich den Laufzeitfehler 1004 mit der Meldung "Anwendungs- oder objektdefinierter Fehler", mit dem ich nicht viel anfangen will.
Den Versuch mit "SaveCopyAs" habe ich unternommen, weil ich eigentlich ja nur eine Kopie der aktuellen Arbeitsmappe auf dem SharePoint speichern will.


Hier meine Quelle: https: // stackoverflow.com / questions / 32786792 / vba-macro-to-save-to-sharepoint-with-dynamic-file-name

Auch hier müssen die Leerzeichen entfernt werden. Das Einfügen als Link hat, warum auch immer, jedesmal die URL dieses Threads eingefügt.

[wisch]

Hallo,

durch weitere Recherchen habe ich nun in Erfahrung bringen können, dass es sich bei dem nicht funktionierendem "SaveCopyAs", wenn das Ziel ein SharePointverzeichnis ist, um einen sehr alten MS Bug handelt.

Als Workaround habe ich einen VBA-Code gefunden, bei dem sich der aktuelle Mappenname gemerkt wird, dann wird mit SaveAs auf dem SharePoint gespeichert, und dann anschliessen nochmals mit SaveAs mit dem gemerkten Namen gespeichert.

Den Code habe ich erfolgreich testen können.

Hier der Code:

Option Explicit
Dim strCurrentFilePath As String           'will hold current path and filename
Dim blnAlertStatus As Boolean              'will hold status of Application.DisplayAlerts
Dim strFullSaveCopyAsName As String        'will hold fullname of file on sharepoint
Dim strTempFullname As String              'will hold the fullname of file which has been saved to sharepoint

Public Function SaveCopyAs2(strFullSaveCopyAsName) As Boolean

'SaveCopyAs replacement
 On Error Resume Next
 blnAlertStatus = Application.DisplayAlerts  'save the status
 Application.DisplayAlerts = False  'switch off alerts

 strCurrentFilePath = ThisWorkbook.FullName  'store production path & filename
 ThisWorkbook.SaveAs (strFullSaveCopyAsName)  'save to sharepoint, using SaveAs instead of failing SaveCopyAs

 strTempFullname = ThisWorkbook.FullName 'store the filename after SaveAs (needed for verification only)
 ThisWorkbook.SaveAs (strCurrentFilePath)  'SavAS , now using the original production path & filename

 Application.DisplayAlerts = blnAlertStatus   'restore the status
 SaveCopyAs2 = (strTempFullname = strFullSaveCopyAsName)  'true if save to sharepoint was successfull

End Function

Example how to use it:

Sub mytst()
 'our sharepoint pathname:
 strShPath= '"https: //xxx-my.sharepoint.com/personal/name_xxx_onmicrosoft_com/Documents/"
 targetName = "test12345.xlsb"   'Filename for SaveCopyAs to sharepiont
 If savecopyas2 (strShPath & targetName) Then
    MsgBox "Success"
 End If
End Sub

Und hier der Link als Text, dei dem bei Verwendung auch wieder die Leerzeichen entfernt werden müssen:

https: // social.msdn.microsoft.com / Forums / en-US/6e6a3a94-e528-451b-866d-2b552c4e53e8 / xl-vba-savecopyas-into-sharepoint-not-working-but-save-as-is-fine?forum=exceldev

Es ist der Post von Quinoman vom Thursday, October 11, 2018 7:55 PM

[maninweb]

Hallo,

schön, dass Du eine Lösung für Dich finden konntest :- )

Gruß

[wisch]

Hallo maninweb,

ja, das freut mich auch. Aber ich habe ja auch die Ergebnisse meiner Recherchen hier eingestellt und somit der Allgemeinheit zugänglich gemacht.

[wisch]

Hallo,

im Rahmen weiterer Tests und Recherchen habe ich einen Code gefunden mit dem die URL des SharePoints einem Laufwerk zuggeordent wird und nach getaner Arbeit die Zuordnung wieder gelöscht wird.

Hier der Code mit Referenz auf die Quelle:

PHP-Code:

Sub set_drive_letter()

'https://stackoverflow.com/questions/31466289/how-to-open-a-file-in-a-sharepoint-site-using-vba

Dim sharepointFolder As String
Dim colDisks As Variant
Dim objWMIService As Object
Dim objNet As Object
Dim objDisk As Variant
Dim fs As Object
Dim I As Integer
Dim J As Integer

'Create FSO and network object
Set objNet = CreateObject("WScript.Network")
Set fs = CreateObject("Scripting.FileSystemObject")

'Get all used Drive-Letters
Set objWMIService = GetObject("winmgmts:\\" & "." & "\root\cimv2")
Set colDisks = objWMIService.ExecQuery("Select * from Win32_LogicalDisk")

'Loop through used Drive-Letters
For Each objDisk In colDisks
    For I = 65 To 90
        'If letter is in use exit loop and remember letter.
        If I = Asc(objDisk.DeviceID) Then
            J = I
            Exit For
        'letters which are not checked yet are possible only
        ElseIf I > J Then
            gl_driveletter = Chr(I) & ":"
            Exit For
        End If
    Next I
    'If a Drive-Letter is found exit the loop
    If gl_driveletter <> "" Then
        Exit For
    End If
Next

'define path to SharePoint
'Range("C_SharePoint") enthäklt dire URL des SharePoints
sharepointFolder = Range("C_SharePoint")

'Map the sharePoint folder to the free Drive-Letter
objNet.MapNetworkDrive gl_driveletter, sharepointFolder
'set the folder to the mapped SharePoint-Path
Set gl_folder = fs.GetFolder(gl_driveletter)

End Sub
Sub reset_drive_letter()

Dim objNet As Object

If gl_driveletter = "" Then
   Exit Sub
End If

Set objNet = CreateObject("WScript.Network")
objNet.RemoveNetworkDrive gl_driveletter
Set objNet = Nothing

gl_driveletter = ""

End Sub 


Die Referenz ging bei dem VOPY nach PHP verloren, deshalb hier ein neuer Versuch:

'https: // stackoverflow.com / questions / 31466289 / how-to-open-a-file-in-a-sharepoint-site-using-vba

Zur Verwendung müssen die Leerzeichen vor und nach den "/" gelöscht werden.

[snb]

Du kannst doch einfach ein Sharepoint Link im Fenster SaveAs machen, wie ich hier z.B gemacht habe für 'Python' und 'website'