titorober23
asked on
copy form and module
H
I copied a form and a module to another database, but for somereason is not working in the new database, i check the names and everyting ios the same as the original.
The only difference between the original database and the new one, is that in the new one is a split database, which i already split the new tables that i copied.
Anything else that i can check or change to make it work?
any idea?
I copied a form and a module to another database, but for somereason is not working in the new database, i check the names and everyting ios the same as the original.
The only difference between the original database and the new one, is that in the new one is a split database, which i already split the new tables that i copied.
Anything else that i can check or change to make it work?
any idea?
Option Compare Database
Option Explicit
Public Function ProcessFileImport(ByVal sFile As String, ByVal sTable As String) As String
On Error GoTo ProcessFileImport_Error
' Excel object variables
Dim appExcel As Excel.Application
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet
' Access object variables
Dim dbs As DAO.Database
Dim rstRead As DAO.Recordset
Dim rstWrite As DAO.Recordset
Dim fld As DAO.Field
' Declared variables
Dim bytWks As Byte
Dim bytMaxPages As Byte
Dim intStartRow As Integer
Dim strData As String
Dim intMaxRow As Integer
Dim strSQL As String
Dim strMsg As String
Dim intLastCol As Integer
Dim intRow As Integer
Dim intRec As Integer
Dim strCurrFld As String
Dim intCol As Integer
Dim intLen As Integer
Dim varValue As Variant
Dim lngErrs As Long
Const cPassword As String = "xxx999"
DoCmd.Hourglass True
' Create the Excel Applicaiton, Workbook and Worksheet and Database object
Set appExcel = Excel.Application
Set wbk = appExcel.Workbooks.Open(sFile)
Set dbs = CurrentDb
' Optionally, you can protect / unprotect with a password
'wkb.Unprotect (cPassword)
' You could loop through sheets, but for this example, we'll just do one.
bytMaxPages = 1
' Sometimes there is header info, so the "Start Row" isn't the first one.
' Set this variable to the first row that contains actual data.
intStartRow = 2
PostMessage "Opening file: " & sFile
For bytWks = 1 To bytMaxPages
' Initialize variables on each pass
Set wks = Nothing
Set rstRead = Nothing
intRow = intStartRow
' Load current worksheet. Find used range to determine row count.
Set wks = appExcel.Worksheets(bytWks)
' Optionally, you can protect / unprotect with a password
'wks.Unprotect (cPassword)
' You need to figure out how many rows this sheet contains, so to know
' how far down to read. That value is saved in intMaxRow
strData = wks.UsedRange.Address
intMaxRow = CInt(Mid(strData, InStrRev(strData, "$")))
'intMaxRow = CInt(Mid(strData, LastInStr(strData, "$")))
strData = ""
' Go get the list of fields for this worksheet from the Field Map table
strSQL = "SELECT [AccessField], [OrdinalPosition] FROM ImportColumnSpecs " & _
"WHERE [ImportName]='" & sTable & "' ORDER BY [OrdinalPosition] ASC;"
Set rstRead = dbs.OpenRecordset(strSQL, dbOpenDynaset)
' If there is a mistake and no specification exists, then exit with message
If rstRead.BOF And rstRead.EOF Then
strMsg = "The import spec was not found. Cannot continue."
MsgBox strMsg, vbExclamation, "Error"
Else
rstRead.MoveLast
rstRead.MoveFirst
intLastCol = rstRead.RecordCount
' The name of the import and destination table should be the same for this
' code to function correctly.
Set rstWrite = dbs.OpenRecordset(sTable, dbOpenDynaset)
Do Until intRow > intMaxRow
' Check row to be sure it is not blank. If so, skip the row
For intCol = 1 To intLastCol
strData = strData & Trim(Nz(wks.Cells(intRow, intCol), ""))
Next
If strData = "" Then
intRow = intRow + 1
Else
intRec = intRec + 1
PostMessage "Processing record " & intRec & ". {StoreID=" & wks.Cells(intRow, 1) & "}"
rstWrite.AddNew
Do Until rstRead.EOF
' Loop through the list of fields, processing them one at a time.
' Grab the field name to simplify code and improve performance.
strCurrFld = Nz(rstRead!AccessField, "")
intCol = rstRead!OrdinalPosition
' Make sure that text fields truncate data at prescribed limits.
' Users may not enter supply more text than the fields can contain.
If dbs.TableDefs(sTable).Fields(strCurrFld).Type = dbText Then
intLen = dbs.TableDefs(sTable).Fields(strCurrFld).Size
varValue = Left(Nz(wks.Cells(intRow, intCol), ""), intLen)
Else
varValue = wks.Cells(intRow, intCol)
End If
' The database schema requires that empty fields contain NULL, not
' the empty string.
If varValue = "" Then varValue = Null
' Handle date columns. Sometimes Excel doesn't format them as dates
If InStr(1, strCurrFld, "Date") > 0 Then
If Not IsDate(varValue) Then
If IsNumeric(varValue) Then
On Error Resume Next
varValue = CDate(varValue)
If Err.Number <> 0 Then
' Can't figure out the date. Set to null
varValue = Null
Err.Clear
End If
On Error GoTo ProcessFileImport_Error
Else
lngErrs = lngErrs + 1
varValue = Null
End If
End If
rstWrite.Fields(strCurrFld) = varValue
Else
' If not a date field, then just write the value to the rst
rstWrite.Fields(strCurrFld) = varValue
End If
rstRead.MoveNext
Loop
If Not rstRead.BOF Then rstRead.MoveFirst
rstWrite.Update
' Reset the variables for processing of the next record.
strData = ""
intRow = intRow + 1
'Debug.Print intRow
End If
Loop
Set wks = Nothing
End If
Next
Exit_Here:
' Report results
strMsg = "Total of " & intRow & " records imported."
PostMessage strMsg
ProcessFileImport = strMsg
' Cleanup all objects (resume next on errors)
On Error Resume Next
' Optionally, you can protect / unprotect with a password
'wkb.Protect (cPassword)
'wks.Protect (cPassword)
Set wks = Nothing
wbk.Close True
Set wbk = Nothing
appExcel.Quit
Set appExcel = Nothing
Set rstRead = Nothing
Set rstWrite = Nothing
Set dbs = Nothing
DoCmd.Hourglass False
Exit Function
ProcessFileImport_Error:
MsgBox Err.Description, vbExclamation, "Error"
Resume Exit_Here
End Function
Private Sub PostMessage(ByVal sMsg As String)
On Error Resume Next
If IsLoaded("frmImport1") Then
Forms!frmImport1!lblMsg.Caption = sMsg
Forms!frmImport1.Repaint
End If
End Sub
Public Function IsLoaded(ByVal sForm As String) As Boolean
On Error Resume Next
'/////////////////////////////////////////////
'
' Returns True if the specified form is open
' in Form view or Datasheet view.
'
'/////////////////////////////////////////////
Const conObjStateClosed = 0
Const conDesignView = 0
If SysCmd(acSysCmdGetObjectState, acForm, sForm) <> conObjStateClosed Then
If Forms(sForm).CurrentView <> conDesignView Then
IsLoaded = True
End If
End If
End Function
Public Function LastInStr(sText As String, sFind As String) As Integer
On Error Resume Next
'//////////////////////////////////////////////////////////////////////////
'
' This function finds the last instance of a character within
' a string of characters and returns an integer representing
' the final position of the desired character.
'
' Typically, this function us used to find the final "\" in
' a file path string
'
'//////////////////////////////////////////////////////////////////////////
Dim intCurrVal As Integer
Dim intLastPosition As Integer
intCurrVal = InStr(sText, sFind)
Do Until intCurrVal = 0
intLastPosition = intCurrVal
intCurrVal = InStr(intLastPosition + 1, sText, sFind)
Loop
LastInStr = intLastPosition
End Function
ASKER
Yes i step line by line through the code, this is an import process, it just delete the record in the target table, but does not import, it looks like in the line that call a public function, stops, but it does not give me any error, it just does not do anything.
if you provide me your email address i can email you tha database so you can take a look at it.
if you provide me your email address i can email you tha database so you can take a look at it.
ASKER
I am trying to upload a zip file with all the code, but i got a message that .accdb extension is not supported
ASKER
I made some changes and now is working, i do not know why
this code was working in my original database
Dim appExcel As Excel.Application
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet
and in the new one i had to declare as Object
Now is working
this code was working in my original database
Dim appExcel As Excel.Application
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet
and in the new one i had to declare as Object
Now is working
rather than emailing me the database, simply attach the mdb as a file to this site. That way, others can contribute to the discussion.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Glad to be of assistance. Hope you now understand about Early and Late binding, and when is a good time to use Late Binding.
AW
AW
AW