У меня проблема с моим проектом, когда нет подключения к Интернету, появляется это сообщение. Я попробовал обработчик ошибок с номером особого случая, но мое сообщение появится после сообщения ниже, которое мне не нравится, потому что оно содержит мою базу данных.Информация.
Function GetTestConnectionString() As String
'==================== ' Connection to SQl Server '==============
GetTestConnectionString = OleDbConnectionString("servername", "db name", "user", "pass")
'===============================================================
End Function
Function GetTestQuery() As String
'==================== ' Get User table ' =======================
GetTestQuery = "SELECT * FROM [dbname].dbo.Users"
' GetTestQuery = "EXEC dbo04.uspExcelTest"
'===============================================================
End Function
'=====================================================
Sub TestImportUsingQueryTable()
Dim conString As String
conString = GetTestConnectionString()
Dim query As String
query = GetTestQuery()
Dim Target As Range
Set Target = ThisWorkbook.Worksheets("AdminPanel2").Cells(10, 2)
Select Case ImportSQLtoQueryTable(conString, query, Target)
Case Else
End Select
End Sub
'======================================================
' ===== QueryTable Functions =====
Sub RefreshWorksheetQueryTables(ByVal ws As Worksheet)
On Error Resume Next
Dim qt As QueryTable
For Each qt In ws.QueryTables
qt.Refresh BackgroundQuery:=True
Next
Dim lo As ListObject
For Each lo In ws.ListObjects
lo.QueryTable.Refresh BackgroundQuery:=True
Next
End Sub
'==================================================================================================================
Function GetTopQueryTable(ByVal ws As Worksheet) As QueryTable
On Error Resume Next
Set GetTopQueryTable = Nothing
Dim lastRow As Long
lastRow = 0
Dim qt As QueryTable
For Each qt In ws.QueryTables
If qt.ResultRange.row > lastRow Then
lastRow = qt.ResultRange.row
Set GetTopQueryTable = qt
End If
Next
Dim lo As ListObject
For Each lo In ws.ListObjects
If lo.SourceType = xlSrcQuery Then
If lo.QueryTable.ResultRange.row > lastRow Then
lastRow = lo.QueryTable.ResultRange.row
Set GetTopQueryTable = lo.QueryTable
End If
End If
Next
End Function
'==================================================================================================================
' ===== Connection String Functions =====
Function OleDbConnectionString(ByVal Server As String, ByVal Database As String, _
ByVal username As String, ByVal Password As String) As String
If username = "" Then
OleDbConnectionString = "Provider=SQLOLEDB.1;Data Source=" & Server _
& ";Initial Catalog=" & Database _
& ";Integrated Security=SSPI;Persist Security Info=False;"
Else
OleDbConnectionString = "Provider=SQLOLEDB.1;Data Source=" & Server _
& ";Initial Catalog=" & Database _
& ";User ID=" & username & ";Password=" & Password & ";"
End If
End Function
'==================================================================================================================
Function OdbcConnectionString(ByVal Server As String, ByVal Database As String, _
ByVal username As String, ByVal Password As String) As String
If username = "" Then
OdbcConnectionString = "Driver={SQL Server};Server=" & Server _
& ";Trusted_Connection=Yes;Database=" & Database
Else
OdbcConnectionString = "Driver={SQL Server};Server=" & Server _
& ";UID=" & username & ";PWD=" & Password & ";Database=" & Database
End If
End Function
'==================================================================================================================
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
'==================================================================================================================
' ===== Import Using QueryTable =====
Function ImportSQLtoQueryTable(ByVal conString As String, ByVal query As String, _
ByVal Target As Range) As Integer
On Error Resume Next
Dim ws As Worksheet
Set ws = Target.Worksheet
Dim address As String
address = Target.Cells(1, 1).address
' Procedure recreates ListObject or QueryTable
If Not Target.ListObject Is Nothing Then ' Created in Excel 2007 or higher
Target.ListObject.Delete
ElseIf Not Target.QueryTable Is Nothing Then ' Created in Excel 2003
Target.QueryTable.ResultRange.Clear
Target.QueryTable.Delete
End If
If Application.Version >= "12.0" Then ' Excel 2007 and higher
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
Else ' Excel 2003
With ws.QueryTables.Add(Connection:=Array("OLEDB;" & conString), _
Destination:=Range(address))
.CommandType = xlCmdSql
.CommandText = StringToArray(query)
.BackgroundQuery = True
.SavePassword = True
.Refresh BackgroundQuery:=False
End With
End If
ImportSQLtoQueryTable = 0
End Function
'==================================================================================================================
'==================================================================================================================
Это код, который я использую в одном модуле для извлечения таблицы запросов. Любая идея, куда следует поместить дескриптор ошибки, если мой интернет был отключен или отключено окноиз (логин SQL сервера)?