在VBA上重复宏,循环

时间:2018-03-23 07:58:59

标签: sql vba integration

我今天的问题与循环同一宏中的几个元素有关。 宏只是从带有直接写在Excel工作表上的SQL查询的DB中获取数据。它工作得很好,但我很难找出添加一个(或2个)其他查询的方法。我不太关心如何在我的Excel工作表上显示输出,但我想了解如何将其他查询添加到第一个宏。您可以想象我想要将相同的宏组合2次,如下所示。第一个蚂蚁和第二个宏之间的唯一区别是顶部的数据库信息(SERVER,DB,USER,PASS),const的名称(Const pcSHEET_SQL As String =" SQL"), const的名称(Const pcSHEET_Balance_log As String =" Balance_log"),sub的名称(Sub TRADER())

我的目标是在Excel工作表上为每个宏设置1个按钮而不是3个,并且当我每个查询当前有一个工作表时,为3个SQL查询提供1个工作表。 谢谢你的帮助。

Option Explicit

Sub TRADER()

Const pcSERVER  As String = "***"
Const pcDB      As String = "***"
Const pcUSER    As String = "***"
Const pcPASS    As String = "***"

Const pcSHEET_SQL As String = "SQL"
Const pcSHEET_Balance_log As String = "Balance_log"

Dim adoCon As New ADODB.Connection
Dim adoRs As New ADODB.Recordset

Dim sSql As String
Dim j As Long
Dim i As Long


'---start---

On Error GoTo errHandler

Sheets(pcSHEET_Balance_log).Columns("A:C").Clear

'SQL作成
With Sheets(pcSHEET_SQL)
    sSql = ""
    j = 1
    Do While .Range("A" & j) <> ""
        sSql = sSql & .Range("A" & j) & " "
        j = j + 1
    Loop
End With


'SQL実行

adoCon.CommandTimeout = 200

adoCon.Open "Driver={PostgreSQL UNICODE};" & _
            "Server=" & pcSERVER & ";" & _
            "Port=5432;" & _
            "Database=" & pcDB & ";" & _
            "Uid=" & pcUSER & ";" & _
            "Pwd=" & pcPASS & ";" & _
            "sslmode=prefer;" 'require;"

adoRs.Open sSql, adoCon, adOpenStatic, adLockReadOnly

'取得データ無し
    If adoRs.BOF And adoRs.EOF Then
        MsgBox "No matching records found."
        GoTo exitHandler
    End If

'adoRs:フィールド出力
For i = 1 To adoRs.Fields.Count
    Cells(1, i) = adoRs.Fields(i - 1).Name
Next i

'adoRs:データ出力
adoRs.MoveFirst
Sheets(pcSHEET_Balance_log).Range("A2").CopyFromRecordset adoRs

'書式設定
With Sheets(pcSHEET_Balance_log).Range(Range("A1"), Cells(1, 
Range("A1").CurrentRegion.Columns.Count))

With .Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorLight2
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With

With .Font
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = 0
End With

End With

exitHandler:
    If Not adoRs Is Nothing Then
        Set adoRs = Nothing
    End If
    If Not adoCon Is Nothing Then
        Set adoCon = Nothing
    End If

    Exit Sub

 errHandler:
MsgBox Err.Description & " (" & Err.Number & ")"
GoTo exitHandler

End Sub

1 个答案:

答案 0 :(得分:0)

<强>建议

我建议你创建一个更标准的reusbale Sub,它只用值Server, DB, User, password, sheetSQL, SheetBalance进行查询。

我的版本

Sub SUB_NAME(ByVal Server As String, ByVal DB As String, ByVal User As String, ByVal Password as String)
    const pcSheet_Foo as String ="" 'what do you want'
    const pcSheet_Bar as String="" 'what do you want'
    'Your Things Here'
End Sub

<强>装运通知

建议#1

您还可以将ByVal单个字符串SQLString传递给所有服务器,数据库,用户,ecc ...而不是处理Sub中的字符串以提取信息,只是为了最小化sub的参数。

<强> E.G。

Sub SQL_WhatIsGoingToDo(ByVal SQL As String, ByVal PC_Sheet_foo As String, ByVal PC_Sheet_bar as String)
    'Work on the string here'
    'Your query here'
End Sub

建议#2

SE将撇号识别为多重注释,记得在发布时添加另一个撇号,以便更好地阅读代码。