CODEWITHSUNDEEP
excelvbaloops
Mike Mirabelli
Mike Mirabelli

Reputation: 410

VBA Write dynamic query from an Excel workbook and .sql file

enter image description hereI have an XL file which has some data validation linked to a list of G/L accounts and Departments, as well as periods. The goal is for the user to select their choice, and for the .sql file to dynamically update the code and using ADO output the query to another workbook with the parameterized data. Unfortunately when I am doing the loop of the text stream, the .AtEndofText property is switching to true on blank lines of the .sql file and the loop dies there (line 9 , for example).

Is there an easier way to do this ? Ie. continue to loop through blank lines?

Or do I have to simply modify my .sql file to remove all blank lines?

Thank you

Option Explicit

Option Base 1

Private Sub Get_and_LoadData()

Dim S As Worksheet, LO As ListObject, Arr() As Variant, NB As Workbook
Dim B As Workbook
Dim fPath  As String, FSO As FileSystemObject, sFile As TextStream
Dim sSQL As Variant, x As Long
Dim aConn As Object, aComm As Object, aRec As Object, ConnSTR As String
Dim fDir As String, tempFile As String
Dim nFile As TextStream

On Error GoTo sqlErr

'Set objects
fPath = "\\silica\vol11\Groups\Finance\Ops Finance\Reporting\F18 Financials\LN_Data_Lookup\SQL_Pull Financial Data_V2.sql"
Set B = ThisWorkbook
Set FSO = New FileSystemObject
Set aConn = VBA.CreateObject("ADODB.Connection")
Set aComm = VBA.CreateObject("ADODB.Command")
Set aRec = VBA.CreateObject("ADODB.Recordset")
Set S = ShTitle
Set LO = S.ListObjects("ParameterTable")

'Array for Parameters (The "Set" Statements range)
Arr = LO.DataBodyRange.offset(, 10)

'Check for source file existence
If VBA.Dir$(fPath, vbNormal) = "" Then
    MsgBox "No .Sql file!", vbExclamation, "Ensure file exists.."
    Exit Sub
Else
    fDir = B.Path & "\"
End If

'Set file system objects
Set sFile = FSO.OpenTextFile(Filename:=fPath, IOMode:=ForReading, _
Create:=False)
tempFile = fDir & "temp" & VBA.Replace(Timer, ".", "") & ".txt"
Set nFile = FSO.CreateTextFile(Filename:=tempFile)

'Get SQL Script
'sSQL = sFile.ReadAll   'read file contents into a variable

'Update SQL SCRIPT
Do Until sFile.AtEndOfStream = True

    'Loop through the lines of the text stream
    Do Until sFile.AtEndOfLine = True

        'Note these are the lines where the SET statements exist
        If sFile.line >= 8 And sFile.line <= 14 Then

            x = x + 1
            nFile.WriteLine Arr(x, 2)
            sFile.SkipLine 'to jump to next line

        ElseIf sFile.line = 65 Or sFile.line = 66 Then 'comment out parameters not used

            nFile.WriteLine "-- " & sFile.ReadLine

        Else

            nFile.WriteLine sFile.ReadLine  'Updates .Line property

        End If

    Loop
   ' x = 0

Loop

'Get connection string to DB
ConnSTR = getConnection(ConnSTR)

'Open connection to the Database
aConn.Open ConnSTR
aConn.defaultdatabase = "ln"

'Load the sql command into an object
With aComm
.ActiveConnection = ConnSTR
.CommandText = sSQL
.CommandTimeout = 300  '5 minute QRY execution max
End With

'Load the record Set
Set aRec = aComm.Execute(sSQL)

'Kill the temp .txt file
Kill tempFile

'Output the record set to new workbook
Set NB = Application.Workbooks.Add
NB.Sheets(1).Range("A1").CopyFromRecordset aRec

'Delete from MEMORY
Set nFile = Nothing
Set aConn = Nothing
Set aComm = Nothing
Set aRec = Nothing
Set sFile = Nothing
sSQL = vbNullString
Set FSO = Nothing
Set B = Nothing
Set NB = Nothing
Set LO = Nothing
Erase Arr
Set S = Nothing

Exit Sub

sqlErr:
MsgBox Err.Description, vbExclamation

End Sub


Function getConnection(conn As String) As String

'LN Connection
getConnection = "Provider=SQLOLEDB.1;Integrated Security=SSPI;" & _
"Persist Security Info=True;Initial Catalog=ln;Data Source=erpdbsvr1\erpln;" & _
"Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;" & _
"Workstation ID=" & LCase(Environ("username")) & "-LT;Use Encryption for Data=False;" & _
"Tag with column collation when possible=False;Trusted_connection=yes;"

End Function

Upvotes: 0

Views: 605

Answers (1)

Tim Williams
Tim Williams

Reputation: 166146

Something more like this (following from my comments above)

Dim inLine
'...
'...
Do Until sFile.AtEndOfStream = True
    inLine = sFile.ReadLine
    If sFile.Line >= 8 And sFile.Line <= 14 Then
        x = x + 1
        nFile.WriteLine Arr(x, 2)
    ElseIf sFile.Line = 65 Or sFile.Line = 66 Then
        nFile.WriteLine "-- " & inLine 'comment out parameters not used
    Else
        nFile.WriteLine inLine
    End If
Loop

Upvotes: 1

Related Questions