VBA code help

[amjadfarhan]

I am using these functions to upload companies data and trying to
retrieve the data in other form but it is show some of data. Can any
one help me please?

Call Function is

Private Sub Command120_Click()
fncExcel2AccessPM "Annual Data", "PMAnnual", "Annual", 7, 3, 2,
Me.Check125.Value
Me.lstPMDate.Requery
End Sub
*******************************
Function fncExcel2AccessPM(sSheet As String, sTable As String,
sTimeFrame As String, lStartDatasetColumn As Long,
lNumberofDatasetColumns As Long, lNumberOfYears As Long, bNzComp As
Boolean)
Dim sStartYear As String
Dim sEndYear As String
Dim sCell As String
Dim lCodeColumn As Long
Dim lStartDateColumn As Long
Dim lEndDateColumn As Long
Dim lStartCompanyRow As Long
Dim lEndCompanyRow As Long
Dim mc As Object
Dim sStartRange As String
Dim sEndRange As String
Dim cn As New ADODB.Connection
Dim rectable As New ADODB.Recordset
Dim sFileName As String
Dim strFilter As String
Dim lMNEMRow As Long
Dim lNameColumn As Long
Dim retval As Long
Dim sINIPathName As String
Dim strPath As String
Dim lPMYearID As Long
Dim sSQL As String
Dim lNoYear As Long
Dim lYearOffset As Long

Dim Y As Long
Dim x As Long


'Include References Microsoft Excel 8.0 Object Library

Dim oExcel As Object


'Dim sSheet As String

'Excel Sheet Name
'sSheet = "Annual Data"
'Table in Database
'sTable = "PMAnnual"
'Suffix in sTable
'sTimeFrame = "Annual" 'sTimeFrame = "3_Yr"
'lStartDatasetColumn = 7
'lNumberofDatasetColumns = 3 'Name, 1st year, 2nd year

'lNumberOfYears = 2 '2000, 2001


If bNzComp Then

If MsgBox("Are you sure that you would like to import data for New
Zealand companies?", vbYesNo + vbDefaultButton2) = vbNo Then
Exit Function
End If
Else

If MsgBox("Are you sure that you would like to import data for
Australian companies?", vbYesNo + vbDefaultButton2) = vbNo Then
Exit Function
End If

End If


Set oExcel = CreateObject("Excel.Application")

strFilter = fncAddFilterItem(strFilter, "Excel Files (*.xls, *.xls)")
sFileName = fncCommonFileOpenSave(InitialDir:="", FileName:="",
Filter:=strFilter, Flags:=0, DialogTitle:="Open Performance Measures",
OpenFile:=True)

If sFileName <> "" Then

oExcel.Workbooks.Open FileName:=sFileName

oExcel.Visible = False


On Error Resume Next

Debug.Print oExcel.Worksheets(sSheet).Cells(1, 1).Value
If Err = 9 Then
MsgBox "This Excel file doesn't contain the sheet: " & sSheet
oExcel.DisplayAlerts = False
oExcel.Quit
oExcel.DisplayAlerts = True
Set oExcel = Nothing
Exit Function
End If

On Error GoTo 0

DoCmd.Hourglass True
DoEvents


lStartCompanyRow = 2
lMNEMRow = 4

x = lStartCompanyRow
Do
x = x + 1
sCell = oExcel.Worksheets(sSheet).Cells(x, lMNEMRow).Value
Loop Until sCell = "" Or x = 25000
lEndCompanyRow = x - 1

If x >= 25000 Then
MsgBox "Error in Excel sheet or more than 25'000 companies!"
DoCmd.Hourglass False
Exit Function
End If


For lNoYear = 0 To lNumberOfYears - 1

sStartYear = oExcel.Worksheets(sSheet).Cells(2,
lStartDatasetColumn + lNoYear).Value

cn.ConnectionString = fncGetConnectionString
cn.Open

sSQL = "SELECT Year, DateOfUpload, PMYearID FROM dbo.PMYear
WHERE (Year = " & sStartYear & ")"

rectable.Open sSQL, cn

If Not rectable.EOF Then
lPMYearID = rectable![PMYearID]
rectable.Close
cn.Close
'delete all company data
subExecuteStoredProc "DELETE FROM dbo." & sTable & " WHERE
(PMYearID = " & lPMYearID & ") "
Else
rectable.Close
cn.Close

'create new year
cn.ConnectionString = fncGetConnectionString
cn.Open

sSQL = "SELECT Year, DateOfUpload, PMYearID FROM
dbo.PMYear"

rectable.CursorType = adOpenKeyset
rectable.LockType = adLockOptimistic
rectable.Open sSQL, cn

rectable.AddNew
rectable!Year = sStartYear
rectable!DateOfUpload = Now
rectable.Update
rectable.Move 0
lPMYearID = rectable![PMYearID]

rectable.Close
cn.Close

End If


cn.ConnectionString = fncGetConnectionString
cn.Open

sSQL = "SELECT * FROM dbo." & sTable

rectable.CursorType = adOpenKeyset
rectable.LockType = adLockOptimistic

rectable.Open sTable, cn, , , adCmdTable

lYearOffset = lNoYear
retval = SysCmd(acSysCmdInitMeter, "Importing Excel Data...",
lEndCompanyRow)
For x = lStartCompanyRow + 1 To lEndCompanyRow

If Right(oExcel.Worksheets(sSheet).Cells(x,
lMNEMRow).Value, 1) = "X" Then

rectable.AddNew

If bNzComp Then
rectable![ASX Code] =
Mid(oExcel.Worksheets(sSheet).Cells(x, lMNEMRow).Value, InStr(1,
oExcel.Worksheets(sSheet).Cells(x, lMNEMRow).Value, ":") + 1, 3) &
"-NZ"
Else
rectable![ASX Code] =
Mid(oExcel.Worksheets(sSheet).Cells(x, lMNEMRow).Value, InStr(1,
oExcel.Worksheets(sSheet).Cells(x, lMNEMRow).Value, ":") + 1, 3)
End If

rectable![PMYearID] = lPMYearID

sCell = oExcel.Worksheets(sSheet).Cells(x,
lStartDatasetColumn + lYearOffset).Value
If InStr(1, sCell, "$") Or sCell = "" Then
rectable.Fields("EPS Growth" & "_" & sTimeFrame) =
Null
Else
rectable.Fields("EPS Growth" & "_" & sTimeFrame) =
sCell
End If
'10
sCell = oExcel.Worksheets(sSheet).Cells(x,
lStartDatasetColumn + (1 * lNumberofDatasetColumns) +
lYearOffset).Value
If InStr(1, sCell, "$") Or sCell = "" Then
rectable.Fields("NET Sales Growth" & "_" &
sTimeFrame) = Null
Else
rectable.Fields("NET Sales Growth" & "_" &
sTimeFrame) = sCell
End If

'13
sCell = oExcel.Worksheets(sSheet).Cells(x,
lStartDatasetColumn + (2 * lNumberofDatasetColumns) +
lYearOffset).Value
If InStr(1, sCell, "$") Or sCell = "" Then
rectable.Fields("Return on Invested Capital" & "_"
& sTimeFrame) = Null
Else
rectable.Fields("Return on Invested Capital" & "_"
& sTimeFrame) = sCell
End If

'16
sCell = oExcel.Worksheets(sSheet).Cells(x,
lStartDatasetColumn + (3 * lNumberofDatasetColumns) +
lYearOffset).Value
If InStr(1, sCell, "$") Or sCell = "" Then
rectable.Fields("Return on Equity" & "_" &
sTimeFrame) = Null
Else
rectable.Fields("Return on Equity" & "_" &
sTimeFrame) = sCell
End If

'19
sCell = oExcel.Worksheets(sSheet).Cells(x,
lStartDatasetColumn + (4 * lNumberofDatasetColumns) +
lYearOffset).Value
If InStr(1, sCell, "$") Or sCell = "" Then
rectable.Fields("Price/Earnings ratio" & "_" &
sTimeFrame) = Null
Else
rectable.Fields("Price/Earnings ratio" & "_" &
sTimeFrame) = sCell
End If
'22
sCell = oExcel.Worksheets(sSheet).Cells(x,
lStartDatasetColumn + (5 * lNumberofDatasetColumns) +
lYearOffset).Value
If InStr(1, sCell, "$") Or sCell = "" Then
rectable.Fields("Return on Assets ratio" & "_" &
sTimeFrame) = Null
Else
rectable.Fields("Return on Assets ratio" & "_" &
sTimeFrame) = sCell
End If
'28
sCell = oExcel.Worksheets(sSheet).Cells(x,
lStartDatasetColumn + (7 * lNumberofDatasetColumns) +
lYearOffset).Value
If InStr(1, sCell, "$") Or sCell = "" Then
rectable.Fields("Net Income Growth" & "_" &
sTimeFrame) = Null
Else
rectable.Fields("Net Income Growth" & "_" &
sTimeFrame) = sCell
End If
'25
sCell = oExcel.Worksheets(sSheet).Cells(x,
lStartDatasetColumn + (6 * lNumberofDatasetColumns) +
lYearOffset).Value
If InStr(1, sCell, "$") Or sCell = "" Then
rectable.Fields("Beta" & "_" & sTimeFrame) = Null
Else
rectable.Fields("Beta" & "_" & sTimeFrame) = sCell
End If
'31
sCell = oExcel.Worksheets(sSheet).Cells(x,
lStartDatasetColumn + (8 * lNumberofDatasetColumns) +
lYearOffset).Value
If InStr(1, sCell, "$") Or sCell = "" Then
rectable.Fields("TSR" & "_" & sTimeFrame) = Null
Else
rectable.Fields("TSR" & "_" & sTimeFrame) = sCell
End If
'34
sCell = oExcel.Worksheets(sSheet).Cells(x,
lStartDatasetColumn + (9 * lNumberofDatasetColumns) +
lYearOffset).Value
If InStr(1, sCell, "$") Or sCell = "" Then
rectable.Fields("EBIT Growth" & "_" & sTimeFrame) =
Null
Else
rectable.Fields("EBIT Growth" & "_" & sTimeFrame) =
sCell
End If
'37
sCell = oExcel.Worksheets(sSheet).Cells(x,
lStartDatasetColumn + (10 * lNumberofDatasetColumns) +
lYearOffset).Value
If InStr(1, sCell, "$") Or sCell = "" Then
rectable.Fields("Asset Turnover" & "_" &
sTimeFrame) = Null
Else
rectable.Fields("Asset Turnover" & "_" &
sTimeFrame) = sCell
End If
'40
sCell = oExcel.Worksheets(sSheet).Cells(x,
lStartDatasetColumn + (11 * lNumberofDatasetColumns) +
lYearOffset).Value
If InStr(1, sCell, "$") Or sCell = "" Then
rectable.Fields("Operating Margin" & "_" &
sTimeFrame) = Null
Else
rectable.Fields("Operating Margin" & "_" &
sTimeFrame) = sCell
End If


rectable.Update

End If
retval = SysCmd(acSysCmdUpdateMeter, x)
Next x

retval = SysCmd(acSysCmdRemoveMeter)
rectable.Close
cn.Close

Next lNoYear


oExcel.DisplayAlerts = False
oExcel.Quit
oExcel.DisplayAlerts = True

Set oExcel = Nothing

'assign company code to ASX code
subExecuteStoredProc "qryUpdatePMCompanyCode '" & "dbo." & sTable &
"'"

DoCmd.Hourglass False

End If

End Function
*********************************************
I am expecting all data in the query "qryfrmPeformanceMeasuresYear"
that query has 4 fields "Year", "CompanyCode" "PMYearID",
"DateofUpload".

Please help me to rectify this problem.

Thanks

 

[John Vinson]

I am expecting all data in the query "qryfrmPeformanceMeasuresYear"
that query has 4 fields "Year", "CompanyCode" "PMYearID",
"DateofUpload".

Please help me to rectify this problem.

I'm sorry, but you're really being unreasonable here.

There's apparently a problem with the query. You haven't indicated
what the problem is.

You've posted over 350 lines of code, 99% of which is almost surely
irrelevant to the question.

How many hours would you like the unpaid volunteers to spend digging
through the code for you?

Could you at least indicate the nature of the problem, and any
specific error messages or portions of the code which might be
relevant?

John W. Vinson[MVP]

 

[faani]

thanx for your quick reply.
It not giving any error but not show the data as well. That code should
get values from the query but its not doing it I don't know why thats
why i posted all code. How can i figure it out?

 

[John Vinson]

thanx for your quick reply.
It not giving any error but not show the data as well. That code should
get values from the query but its not doing it I don't know why thats
why i posted all code. How can i figure it out?

Step through the code in debug mode until the query is built; copy and
paste it from the Immediate window to the SQL window of a new query;
open the query and diagnose why it's not working.

John W. Vinson[MVP]