Hi team,
i have been moved to a different role in my org and below is the vba code which my predecessor (currently not with org) has written. i would like to understand each line in this so that i can further do my R&D.
Please help me.
i have been moved to a different role in my org and below is the vba code which my predecessor (currently not with org) has written. i would like to understand each line in this so that i can further do my R&D.
Please help me.
Code:
[/COLOR]
Sub openActuals()
Dim file As String
Dim cnstr, qry, pmonth, colstr As String
Dim wrkbk As Workbook
Dim x, rowLabel, t, l As Integer
Dim kval, y As Long
Dim version As Long
Dim periodmonth As Long
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strSQL As String
Dim lngRecsAff As Long
file = Application.GetOpenFilename()
If Len(file) > 0 Then
Else
If file = False Then GoTo Cancel
End If
Set wrkbk = Workbooks.Open(file)
x = 30
Do Until wrkbk.Sheets("Ct_sk").Cells(x, "A").Value = "Row Labels"
x = x + 1
Loop
If wrkbk.Sheets("Ct_sk").Cells(x - 6, "B").Value = "Column Labels" Then
y = 2
Do Until wrkbk.Sheets("Ct_sk").Cells(x - 5, y).Value = "Sum of $K"
y = y + 1
Loop
kval = y
Do Until wrkbk.Sheets("Ct_sk").Cells(x - 4, y).Value = "Actuals"
y = y + 1
Loop
version = y
cnstr = "Provider=sqloledb;Data Source=10.xxx.xxx.xx;Initial Catalog=Fin_G;User Id=User_123;Password=User_123"
Set cn = New ADODB.Connection
cn.Open cnstr
qry = "select distinct b.[Period-Month] from ref_current_month a left outer join ref_timeSeries b on a.[report date] = b.[Report Date]"
Set rs = cn.Execute(qry)
If Not rs.EOF Or Not rs.BOF Then
pmonth = rs.Fields(0)
End If
Do Until InStr(1, wrkbk.Sheets("Ct_sk").Cells(x - 3, y).Value, "Total") > 0 'And InStr(1, wrkbk.Sheets("Ct_sk").Cells(x - 2, y).Value, "Total") > 0
y = y + 1
Loop
periodmonth = y
t = x
Do Until wrkbk.Sheets("Ct_sk").Cells(t, "A").Value = "Grand Total"
t = t + 1
Loop
wrkbk.Sheets("Ct_sk").Activate
wrkbk.Sheets("Ct_sk").Range("$" & Col_Letter(y) & "$" & t).Select
Selection.ShowDetail = True
wrkbk.Sheets("Sheet1").Activate
l = 1
Do Until wrkbk.Sheets("Sheet1").Cells(1, l).Value = ""
If l = 1 Then
colstr = "[" & wrkbk.Sheets("Sheet1").Cells(1, l).Value & "] nvarchar(255)"
Else
If wrkbk.Sheets("Sheet1").Cells(1, l).Value = "$K" Or wrkbk.Sheets("Sheet1").Cells(1, l).Value = "$M" Or wrkbk.Sheets("Sheet1").Cells(1, l).Value = "Amount" Or wrkbk.Sheets("Sheet1").Cells(1, l).Value = "Local Currency Amount" Or wrkbk.Sheets("Sheet1").Cells(1, l).Value = "Fixed Currency" Then
colstr = colstr & ",[" & wrkbk.Sheets("Sheet1").Cells(1, l).Value & "] float"
Else
colstr = colstr & ",[" & wrkbk.Sheets("Sheet1").Cells(1, l).Value & "] nvarchar(255)"
End If
End If
l = l + 1
Loop
qry = "drop table src_Actuals_Rawdata_stg"
cn.CommandTimeout = 60
Set rs = cn.Execute(qry)
qry = "Create table src_Actuals_Rawdata_stg(" & colstr & ")"
cn.CommandTimeout = 60
Set rs = cn.Execute(qry)
cn.Close
On Error GoTo test_Error
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & file & ";" & _
"Extended Properties=Excel 8.0"
'Import by using Jet Provider.
strSQL = "Insert INTO [odbc;Driver={SQL Server};" & _
"Server=10.xxx.xxx.xx;Database=Fin_G;" & _
"UID=User_123;PWD=User_123].src_Actuals_RawData_stg " & _
"Select * FROM [Sheet1$]"
'MsgBox (strSQL)
Debug.Print strSQL
cn.Execute strSQL, lngRecsAff ', adExecuteNoRecords
Debug.Print "Records affected: " & lngRecsAff
cn.Close
wrkbk.Sheets("Sheet1").Delete
wrkbk.Save
wrkbk.Close
cnstr = "Provider=sqloledb;Data Source=10.xxx.xxx.xx;Initial Catalog=Fin_G;User Id=User_123;Password=User_123"
Set cn = New ADODB.Connection
cn.CommandTimeout = 4080
cn.Open cnstr
' If InStr(1, file, "Q1") > 0 Then
' qt = "Q1"
' ElseIf InStr(1, file, "Q2") > 0 Then
' qt = "Q2"
'
' ElseIf InStr(1, file, "Q3") > 0 Then
' qt = "Q3"
'
' ElseIf InStr(1, file, "Q4") > 0 Then
' qt = "Q4"
'
' End If
' qry = "delete from src_Actuals_RawData where WD = '" & cmb_wd.Value & "' and quarter = '" & qt & "' and [report date] = (select distinct [Report Date] from ref_current_month)"
'cn.Execute (qry)
qry = "delete from tmp_WD"
cn.Execute (qry)
qry = "insert into tmp_WD values ('" & cmb_wd.Value & "')"
'qry = "Exec [proc_actuals_stgtoprod] '" & cmb_wd.Value & "'"
Set rs = cn.Execute(qry)
cn.Close
Set cn = Nothing
On Error GoTo 0
Exit Sub
test_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure test of VBA Document ThisWorkbook"
End If
Cancel:
ThisWorkbook.Sheets("input").Activate
End Sub
Last edited by a moderator: