Mar 09 2021 11:12 AM
Good morning to all.
I am new to this community and turning to you for some help on a topic that I have seen posted in the past but have not found a proper solution for yet:
I developed code for my client who uses SharePoint to share files within their team. I have a problem with files "hanging" or "ghosting" in the VBA Project Explorer window after close event.
The simple code ('set wkbk = nothing') will eliminate the problem on my PC; however, this will not be the case for my client's VBA Project Editor; eventually, this creates multiple replicas of the same file names eventually leading to issues and even crashes. We are running on MS Office 365 (PC). I believe the issue may be related to SharePoint.
Option Explicit
Sub TestOpenWbk()
Dim WkBk As Workbook
Set WkBk = Workbooks.Open("C:\UserName\FilePath\FileName.xlsx")
WkBk.Close savechanges:=False
Set WkBk = Nothing 'removes the file from the project editor on my PC but not on client
End Sub
Any insights are truly welcome.
Thank you in advance.
Mar 10 2021 05:06 AM
Mar 10 2021 08:10 AM
Mar 10 2021 09:42 AM
It's not a link, the editor probably converted it to a link automatically.
You have to enter the address of your SharePoint.
Set wshshell = CreateObject("WScript.Shell")
wshshell.Run https://firma.sharepoint.com/:x:/s/CutRedTape-EES2019/EbmmNX5qGehEv5Z2ROk5my8BeZ4DlQ039JaYsEltZcUIqA?e=hBBVNe
Mar 10 2021 09:49 AM
Here is another code fresh from the internet, untested.
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
If the code gets stuck, put the parameters in brackets so that you force the conversion from the variant to a string.
Thank you for your understanding and patience
Nikolino
I know I don't know anything (Socrates)
Mar 11 2021 06:09 AM
Solution