×

Loading...
Ad by
  • 最优利率和cashback可以申请特批,好信用好收入offer更好。请点链接扫码加微信咨询,Scotiabank -- Nick Zhang 6478812600。
Ad by
  • 最优利率和cashback可以申请特批,好信用好收入offer更好。请点链接扫码加微信咨询,Scotiabank -- Nick Zhang 6478812600。

请问有没有会ADODB.connection 的IT大侠啊?老板要求用excel vba编写一段可以将Oracle里面的数据导入excel以便于data analyst的Macro.

本文发表在 rolia.net 枫下论坛完全没有接触SQL,google了一下代码看不懂,有没有大侠可以教我一下底下的代码是什么意思,如何运用?如果可以线下有偿tutorial那就更好了,万分感谢!!

Sub EDW(UID As String, PWD As String, sName As String)

Dim Conn As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim sqlText As String, server As String

'On Error GoTo ErrMsg

Application.Calculation = xlManual

Application.ScreenUpdating = False
Application.EnableEvents = False

Conn.Open "PROVIDER=MSDAORA.Oracle;DATA SOURCE=" & sName & ";" & "USER ID=" & UID & ";PASSWORD=" & PWD
'MsgBox "Sucessfully connected to EDW"
cmd.ActiveConnection = Conn
cmd.CommandType = adCmdText


'Prepare for Progress bar ********************************************
Dim i As Integer
Dim loopL As Double 'constant of how many loops needed to run till 50% of progress bar
Dim loopR As Single 'variable

loopL = 1 / 3 ' a constant
loopR = 0

ProgressBar.Show
'UpdateProgressBar 0

'****************************************************
cleanSheet

'update worksheets("EDW Results") ********************************************


Call queryUpdate(cmd, "Query1", "A:A") 'Trades
loopR = loopR + loopL
UpdateProgressBar loopR

Call queryUpdate(cmd, "Query3", "F:F") 'Retails
loopR = loopR + loopL
UpdateProgressBar loopR

Call queryUpdate(cmd, "Query4", "K:K") 'Retails
loopR = loopR + loopL
UpdateProgressBar loopR

Call queryUpdate(cmd, "Query6", "T:T") 'Retails
loopR = loopR + loopL
UpdateProgressBar loopR

Call queryUpdate(cmd, "Query7", "AD:AD") 'Trades
loopR = loopR + loopL
UpdateProgressBar loopR

Call queryUpdate(cmd, "Query8", "AO:AO") 'Retails
loopR = loopR + loopL
UpdateProgressBar loopR

Unload ProgressBar

Worksheets("Sheets1").Select

ThisWorkbook.RefreshAll

Cells(1, "O").Value = Date
Application.Calculation = xlAutomatic

'Turn off the disables
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub

ErrMsg:
MsgBox Err.Source & Chr(13) & Err.Description

End Sub


Sub queryUpdate(cmd As ADODB.Command, query As String, inputcolumn As String)
Dim sqlText As String
Dim row As Long, Findex As Long, x As Long
Dim i As Long
Dim RS As New ADODB.Recordset
Dim currentD As Date
'******************************************************************************
' Put your query next

sqlText = Worksheets("Query").Range(query).Value

'******************************************************************************

cmd.CommandText = sqlText

Set RS = cmd.Execute
With Worksheets("EDW Results") 'Change this to the name of the sheet you want to return data to


row = 2


Do While Not RS.EOF 'This loops through the data and puts it in the spreadsheet Data
row = row + 1
For Findex = 0 To RS.Fields.Count - 1
.Cells(row, inputcolumn).Offset(0, Findex) = RS.Fields(Findex).Value

Next Findex
RS.MoveNext
Loop


End With

Set RS = Nothing
Exit Sub

End Sub更多精彩文章及讨论,请光临枫下论坛 rolia.net
Report