Я разместил предыдущий вопрос относительно SQL-запросов в Excel здесь:
VBA - Импорт всех строк из таблицы в SQL в Excel
Что, оказалось, было проблемой надзора, которую я с тех пор решил. Однако теперь я сталкиваюсь с новой проблемой при попытке импортировать другую таблицу.
Когда я впервые собрал макрос, он был для таблицы с именем подчеркивания, например: my_table_1_query
Теперь я попытался использовать точно такой же код с именем таблицы, например: my-table_query_1 , и я получил ошибку в этой строке:
.Refresh BackgroundQuery:=False
Сообщение об ошибке:
Неверный синтаксис рядом с '-'
Это в функции ImportSQLtoQueryTable
Вот код:
Функция
ImportSQLtoQueryTable
Function ImportSQLtoQueryTable(ByVal conString As String, ByVal query As String, ByVal target As Range) As Integer
Dim ws As Worksheet
Set ws = target.Worksheet
Dim address As String
address = target.Cells(1, 1).address
'Procedure recreates ListObject or QueryTable
'For Excel 2007 or higher
If Not target.ListObject Is Nothing Then
target.ListObject.Delete
End If
'For 2007 or higher
If Application.Version >= "12.0" Then
With ws.ListObjects.Add(SourceType:=0, Source:=Array("OLEDB;" & conString), Destination:=Range(address))
With .QueryTable
.CommandType = xlCmdSql
.CommandText = StringToArray(query)
.BackgroundQuery = True
.SavePassword = True
.Refresh BackgroundQuery:=False
.ListObject.Name = "DB KW Component Table"
End With
End With
End If
ImportSQLtoQueryTable = 0
End Function
StringToArray
Function StringToArray(Str As String) As Variant
Const StrLen = 127
Dim NumElems As Integer
Dim Temp() As String
Dim I As Integer
NumElems = (Len(Str) / StrLen) + 1
ReDim Temp(1 To NumElems) As String
For I = 1 To NumElems
Temp(I) = Mid(Str, ((I - 1) * StrLen) + 1, StrLen)
Next I
StringToArray = Temp
End Function
GetTestConnectionString
Function GetTestConnectionString() As String
GetTestConnectionString = OleDbConnectionString( _
"Server Location", _
"Connection DB", _
"Username", _
"Password")
End Function
OleDbConnectionString
Function OleDbConnectionString(ByVal Server As String, ByVal Database As String, ByVal Username As String, ByVal Password As String) As String
If Username = "" Then
MsgBox "User name for DB login is blank. Unable to Proceed"
Else
OleDbConnectionString = _
"Provider=SQLOLEDB.1;" & _
"Data Source=" & Server & "; " & _
"Initial Catalog=" & Database & "; " & _
"User ID=" & Username & "; " & _
"Password=" & Password & ";"
End If
End Function
Sub:
TestImportUsingQueryTable
Sub TestImportUsingQueryTable()
Dim conString As String, query As String
Dim DestSh As Worksheet
Dim tmpltWkbk As Workbook
Dim target As Range
'Set workbook to be used
Set tmpltWkbk = Workbooks("New DB.xlsm")
'Need to add check if sheet already exists
'If sheet already exists then just refresh table
'Add a new sheet called "DB Table"
Set DestSh = tmpltWkbk.Worksheets.Add
DestSh.Name = "DB Table"
With DestSh
.UsedRange.Clear
Set target = .Cells(2, 2)
End With
'Get connection string
conString = GetTestConnectionString()
'Set Query to table
query = "SELECT * FROM SAT_Keyword_DB_X7.dbo.kw_link-tbl_keyword_components"
Select Case ImportSQLtoQueryTable(conString, query, target)
Case Else
End Select
End Sub