I had one idea for long time that how can we store all the utility code into one single place(Need to be online so that we can download and use from multiple computer). So I get that idea from Java Maven technology. I like that we can just add bunch of code by adding some metadata. I created something like this.
So here is the idea. I want to use a Text.cls Utility class and that class will be updated in one repo but I can use that class in 100 project. And I don’t want to do below things everytime
- Download updated file from Github
- Remove current Text.cls
- Import new updated code
So I tried to automate that process. and Here what you need to do that.
- One comment which will start with ‘@GithubRawURL: “Put Text.cls file raw view URL” here. Put that comment on the source so you don’t need to do for every project you import.
- And Click on button and it will import it.
And Here is the button for updating code.
And Here is the code associated for that button
Option Explicit
#If VBA7 Then ' Excel 2010 or later
Public Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
(ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#Else ' Excel 2007 or earlier
Public Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
(ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#End If
Public Sub UpdateCodeFromGithub()
Dim CurrentProject As VBProject
Set CurrentProject = GetActiveProject()
Dim CurrentComponent As VBComponent
Set CurrentComponent = GetComponent()
Dim FileExtension As String
FileExtension = GetExtensionForComponent(CurrentComponent)
Dim FileLocation As String
Dim Counter As Long
For Counter = 1 To CurrentComponent.CodeModule.CountOfDeclarationLines
Dim CodeLine As String
CodeLine = CurrentComponent.CodeModule.Lines(Counter, 1)
Const SOURCE_MARKER As String = "'@GithubRawURL:"
If Text.IsStartsWith(CodeLine, SOURCE_MARKER) Then
FileLocation = Text.AfterDelimiter(CodeLine, SOURCE_MARKER)
Exit For
End If
Next Counter
If FileLocation = vbNullString Then
MsgBox "No source found to get updated code."
Exit Sub
End If
Dim TempFilePath As String
TempFilePath = DownloadFromURLToTempFolder(CurrentComponent.Name & FileExtension, FileLocation)
Dim BackupPath As String
BackupPath = Environ$("temp") & "\" & CurrentComponent.Name & "Backup" & FileExtension
CurrentComponent.Export BackupPath
Dim ComponentName As String
ComponentName = CurrentComponent.Name
Debug.Print "Backup has been keep at : " & BackupPath
CurrentProject.VBComponents.Remove CurrentComponent
CurrentProject.VBComponents.Import TempFilePath
CurrentProject.VBComponents.Item(ComponentName).Activate
Debug.Print "Code has been updated from:" & FileLocation
End Sub
Public Function DownloadFromURLToTempFolder(FileName As String, FileURL As String) As String
Dim TempFilePath As String
TempFilePath = Environ$("temp") & Application.PathSeparator & FileName
If Dir(TempFilePath, vbNormal) <> vbNullString Then Kill TempFilePath
Dim DownloadResult As Long
DownloadResult = URLDownloadToFile(0, FileURL, TempFilePath, 0, 0)
Dim Code As String
If DownloadResult = 0 Then
Debug.Print "File Download complete and store to : " & TempFilePath
DownloadFromURLToTempFolder = TempFilePath
Code = GetTextFileContent(TempFilePath)
Else
Debug.Print "Failed to download from : " & FileURL & " using URLDownloadToFile WIN API."
Debug.Print "Let's try using WinHttp.WinHttpRequest"
Dim HttpHandler As WinHttp.WinHttpRequest
Set HttpHandler = New WinHttp.WinHttpRequest
With HttpHandler
Const GITHUB_ACCESS_TOKEN As String = "YOUR ACCESS TOKEN"
.Open "Get", FileURL
.setRequestHeader "Authorization", "Bearer " & GITHUB_ACCESS_TOKEN
.setRequestHeader "Accept", "application/vnd.github.v3.raw"
.send
Code = .ResponseText
End With
DownloadFromURLToTempFolder = TempFilePath
End If
Code = VBA.Replace(Code, vbLf, vbCrLf)
WriteContentToTextFile TempFilePath, Code
End Function
Private Sub WriteContentToTextFile(FullPath As String, Content As String)
Dim FileNo As Integer
FileNo = FreeFile
Open FullPath For Output As #FileNo
Print #FileNo, Content
Close #FileNo
End Sub
Private Function GetExtensionForComponent(CurrentComponent As VBComponent) As String
Select Case CurrentComponent.Type
Case vbext_ct_ClassModule
GetExtensionForComponent = ".cls"
Case vbext_ct_Document
GetExtensionForComponent = ".doccls"
Case vbext_ct_MSForm
GetExtensionForComponent = ".frm"
Case vbext_ct_StdModule
GetExtensionForComponent = ".bas"
End Select
End Function
Public Function GetComponent() As VBComponent
Set GetComponent = Application.VBE.SelectedVBComponent
End Function
Public Function GetActiveProject() As VBProject
Set GetActiveProject = Application.VBE.ActiveVBProject
End Function
Public Function GetTextFileContent(FullFilePath As String) As String
Dim FileNo As Integer
FileNo = FreeFile
Open FullFilePath For Input As #FileNo
GetTextFileContent = Input$(LOF(FileNo), FileNo)
Close #FileNo
End Function
And to use this code you have to Add some Reference in VBA ( By going Tools>References > “Find Correct One and Check and Press OK”)
Few learnings from this post.
- If you download code from Github and Try to import manually then you will see often time it doesn’t work because Github Uses VbLf for line feed whereas VBA uses VbCrLf as line feed.
- You can pass your access token to get file code from Github private repo.
- You can adapt this idea to update all dependency codes (You can update VBA, Power Query, or Lambda as well).
