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
SolutionSep 26 2022 05:36 AM
I had the same issue with Windows 10 and Excel 2016. This came up recently although I have been designing and using complex add-ins for many years. Every time I opened and closed an .xlsm file (without closing Excel), the code remained displayed in the VBE editor. Even worse, If I do that n times with the same .xlsm file, the VBE editor n times the same code. The end result is an "out of memory" error and a crash of Excel.
The solution was to uninstall Google Drive although I do not really understand how Google Drive interacts with the VBE editor. The problem is gone, and so is Google Drive unfortunately.
Uninstalling Google Drive was not straightforward because Uninstall attempts fail with a message telling to quit Google Drive first... and there is no 'Quit Google Drive' command. I had to end all Goggle Drive tasks with Task Manager to successfully uninstall it.
Mar 03 2023 07:42 AM
Mar 11 2021 06:09 AM
Solution