【发布时间】:2019-03-20 20:02:46
【问题描述】:
大部分代码来自本教程:
https://www.excel-sql-server.com/excel-sql-server-import-export-using-vba.htm
我已经成功地将所需的表从我的数据库导入到一个新的工作表中。
但是,我注意到工作表中缺少 +- 230 行,这些行存在于 DB 表中。查看代码,我看不出它为什么不导入整个表的任何真正原因。我希望这里有人能够指出任何错误/错误。
代码:
功能:
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
'For Excel 2003
ElseIf Not target.QueryTable Is Nothing Then
target.QueryTable.ResultRange.Clear
target.QueryTable.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
End With
End With
'For Excel 2003
Else
With ws.QueryTables.Add(Connection:=Array(conString), Destination:=Range(address))
.CommandType = xlCmdSql
.CommandText = StringToArray(query)
.BackgroundQuery = True
.SavePassword = True
.Refresh BackgroundQuery:=False
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 type", _
"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
主副:
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("Template.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 master.dbo.kw_keyword_tbl"
Select Case ImportSQLtoQueryTable(conString, query, target)
Case Else
End Select
End Sub
【问题讨论】:
-
我会先删除“on error resume next”行,然后忘记该语句的存在。这基本上是在对代码说,如果您遇到错误,请忽略它并继续前进。也许你遇到了 230 错误,但你永远不会知道。让错误发生并优雅地处理。错误发生时,它们提供了很多有用的信息。不应将它们推到地毯下并隐藏起来。
-
如何知道没有其他错误?大多数代码以 ImportSQLtoQueryTable 开头。从那里到方法结束的任何错误都会被吞没。
-
我同意与
On Error Resume Next相关的评论,但我也同意有时克服错误比处理错误要容易得多......但是,在这些情况下,如果你是确信您可以跳过该错误,您应该仅使用On Error Resume Next封装代码的特定部分 --- 一些代码 ---On Error GoTo 0,而不是整个脚本。 -
你怎么知道没有错误?您实际上对此进行了编码以捕获错误并默默地继续前进。可悲的是,VBA 中的错误处理真的很糟糕。当您捕获某些类型的错误并以不同的方式处理它们时,这会容易得多。如果您确定没有错误,为什么不删除该行并再次运行您的代码?您可能会找到您正在寻找的问题。
-
没有该行正在抑制错误。删除它,错误就会显现出来。
标签: sql sql-server excel vba