Iam developing a vba marco-script for a customer which downloads zip file from github, and unpack the zip folder to a folder.
The script will create a folder ´pb´ if it doesnt exist already - and if the folder already exist it will delete the folder and create a new.
It works properly on my own pc, but the customer is getting this error as shown on screenshot.
The path on client's computer is following:
C:\Users\Nicol\xxx\xxx - Carina og Nicolas - Carina og Nicolas\Analyseværktøjer\Rådgivningsværktøj
And the client is using mircosoft teams drive, but it didnt work neither on his own desktop folder. So i dont know what cause it.
I cant figure out how to solve this.
[
Here is full source code of the marco.
Option Explicit
Function versionIsOutdated(strDir As String, strPath As String)
Dim FSO As New FileSystemObject
Dim FileToRead As Variant
Dim TextString As String
Dim path As String
path = strPath & strDir
If FSO.FolderExists(path) Then
' exist, lookup versionNumber
Dim FileUrl As String
Dim objXmlHttpReq As Object
Dim objStream As Object
Dim strResult
FileUrl = "https://raw.githubusercontent.com/Securelife-A-S/pb_integration/main/version.txt"
Set objXmlHttpReq = CreateObject("MSXML2.ServerXMLHTTP.6.0")
objXmlHttpReq.Open "GET", FileUrl, False
objXmlHttpReq.send
strResult = objXmlHttpReq.responseText
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FileToRead = FSO.OpenTextFile(path & "\pb_integration-main\version.txt", ForReading) 'add here the path of your text file
TextString = FileToRead.ReadAll
FileToRead.Close
Debug.Print (TextString)
Debug.Print (strResult)
Dim compResult As Integer
If StrComp(TextString, strResult) = 0 Then
Debug.Print ("Version is up to date")
versionIsOutdated = False
Else
versionIsOutdated = True
Debug.Print ("Version is outdated")
End If
Else
versionIsOutdated = True
Debug.Print ("Folder is not downloaded yet")
End If
End Function
Function MkDir(strDir As String, strPath As String)
Dim FSO As New FileSystemObject
Dim path As String
path = strPath & strDir
If FSO.FolderExists(path) Then
' exist, so delete the folder
FSO.DeleteFolder path, True
Debug.Print "Deleting folder"
End If
If Not FSO.FolderExists(path) Then
' doesn't exist, so create the folder
FSO.CreateFolder path
Debug.Print "Creating folder"
End If
End Function
Function downloadAndUnzip()
Dim FileUrl As String
Dim objXmlHttpReq As Object
Dim objStream As Object
Dim strResult
FileUrl = "https://raw.githubusercontent.com/Securelife-A-S/pb_integration/main/version.txt"
Set objXmlHttpReq = CreateObject("MSXML2.ServerXMLHTTP.6.0")
objXmlHttpReq.Open "GET", FileUrl, False
objXmlHttpReq.send
strResult = objXmlHttpReq.responseText
Debug.Print (strResult)
FileUrl = "https://github.com/Securelife-A-S/pb_integration/archive/refs/heads/main.zip"
Set objXmlHttpReq = CreateObject("MSXML2.ServerXMLHTTP.6.0")
objXmlHttpReq.Open "GET", FileUrl, False
objXmlHttpReq.send
If objXmlHttpReq.Status = 200 Then
Set objStream = CreateObject("ADODB.Stream")
objStream.Open
objStream.Type = 1
objStream.Write objXmlHttpReq.responseBody
objStream.SaveToFile ThisWorkbook.path & "\" & "pb.zip", 2
objStream.Close
End If
Debug.Print ("Download done")
Dim ShellApp As Object
'Copy the files & folders from the zip into a folder
Set ShellApp = CreateObject("Shell.Application")
ShellApp.Namespace(ThisWorkbook.path & "\pb").CopyHere ShellApp.Namespace(ThisWorkbook.path & "\pb.zip").Items
Debug.Print ("Unpack done")
End Function
Function DeleteVBComponent()
Dim CompName As String
CompName = "Main"
'Disabling the alert message
Application.DisplayAlerts = False
'Ignore errors
On Error Resume Next
'Delete the component
Dim vbCom As Object
Set vbCom = Application.VBE.ActiveVBProject.VBComponents
vbCom.Remove VBComponent:= _
vbCom.Item(CompName)
On Error GoTo 0
'Enabling the alert message
Application.DisplayAlerts = True
End Function
Function addBasFile()
Dim path As String
Dim objModule As Object
path = ThisWorkbook.path & "\pb\pb_integration-main\Main.bas"
Set objModule = Application.VBE.ActiveVBProject.VBComponents.Import(path)
objModule.Name = "Main"
Debug.Print path
End Function
Sub Workbook_Open()
Dim asd As Boolean
asd = versionIsOutdated("pb", ThisWorkbook.path & "\")
If asd = True Then
MsgBox "Der er kommet ny version - Downloading påbegyndt"
Call MkDir("pb", ThisWorkbook.path & "\")
Call downloadAndUnzip
Call DeleteVBComponent
Call addBasFile
Application.Run ("Main.init")
End If
End Sub