У меня есть файл XL с проверкой данных, связанной со списком основных счетов и отделов, а также периодами.Цель состоит в том, чтобы пользователь мог выбрать свой выбор, а для файла .sql - динамически обновить код и с помощью ADO вывести запрос в другую рабочую книгу с параметризованными данными.К сожалению, когда я выполняю цикл текстового потока, свойство .AtEndofText переключается в true в пустых строках файла .sql, и цикл умирает там (например, в строке 9).
Есть либолее простой способ сделать это?То есть.продолжать цикл через пустые строки?
Или мне нужно просто изменить мой файл .sql, чтобы удалить все пустые строки?
Спасибо
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