Load Microsoft queries into command texts of connections.

gistfile1.vb

Dim queryFolderFullPath As String
Public Const queryFolderRelativePath = "Microsoft Query"  'Relative to the workbook

Sub LoadMSQueries()
  Dim queryFiles() As String
  Dim i As Integer
  queryFiles = ListQueryFiles()
  For Each conn In ActiveWorkbook.Connections
    For i = LBound(queryFiles) To UBound(queryFiles)
      If conn.Name = RemoveFileExtension(queryFiles(i)) Then
        If conn.Type = xlConnectionTypeODBC Then
          Set odbcCn = conn.ODBCConnection
          odbcCn.CommandText = LoadFileContent(queryFolderFullPath + "\" + queryFiles(i))
          conn.Refresh
        End If
      End If
    Next
  Next
End Sub

Public Function RemoveFileExtension(sFile As String) As String
  Dim pos As Integer
  pos = InStrRev(sFile, ".")
  RemoveFileExtension = Left(sFile, IIf(pos > 0, pos - 1, Len(sFile)))
End Function

Public Function ListQueryFiles() As String()
  queryFolderFullPath = ActiveWorkbook.Path + "\" + queryFolderRelativePath
  If Dir(queryFolderFullPath) <> "" Then
    MsgBox ("Folder MSQueries/ not found. Please build one.")
  End If
  
  Set fileObj = New Scripting.FileSystemObject
  Set queryFolder = fileObj.GetFolder(queryFolderFullPath)
  Dim paths() As String
  ReDim paths(0 To 0) As String
  For Each queryFile In queryFolder.Files
    paths(UBound(paths)) = queryFile.Name
    ReDim Preserve paths(0 To UBound(paths) + 1) As String
  Next
  ReDim Preserve paths(0 To UBound(paths) - 1) As String
  ListQueryFiles = paths
End Function

Public Function LoadFileContent(sFile As String) As String
  Dim iFile As Integer
     
  On Local Error Resume Next
   ' \\ Use FreeFile to supply a file number that is not already in use
  iFile = FreeFile
   
  ' \\ ' Open file for input.
  Open sFile For Input As #iFile
     
  ' \\ Return (Read) the whole content of the file to the function
  LoadFileContent = Input$(LOF(iFile), iFile)
     
  Close #iFile
End Function