copy form and module

Posted on 2008-10-14
Last Modified: 2012-06-21
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"
         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), ""))
            If strData = "" Then
               intRow = intRow + 1
               intRec = intRec + 1
               PostMessage "Processing record " & intRec & ".  {StoreID=" & wks.Cells(intRow, 1) & "}"
               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)
                     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
                           End If
                           On Error GoTo ProcessFileImport_Error
                           lngErrs = lngErrs + 1
                           varValue = Null
                        End If
                     End If
                     rstWrite.Fields(strCurrFld) = varValue
                     ' If not a date field, then just write the value to the rst
                     rstWrite.Fields(strCurrFld) = varValue
                  End If
               If Not rstRead.BOF Then rstRead.MoveFirst
               ' Reset the variables for processing of the next record.
               strData = ""
               intRow = intRow + 1
               'Debug.Print intRow
            End If
         Set wks = Nothing
      End If
   ' 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
   Set appExcel = Nothing
   Set rstRead = Nothing
   Set rstWrite = Nothing
   Set dbs = Nothing
   DoCmd.Hourglass False
   Exit Function
   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
   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)
    LastInStr = intLastPosition
End Function

Open in new window

Question by:titorober23
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 3
LVL 44

Expert Comment

ID: 22711994
when you say "some reason is not working in the new database", how are you aware that it is not working?  Are there error messages, or does it just not create the same end result?  Have you stepped through the code, to see what is happening, line by line?

Author Comment

ID: 22712024
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.

Author Comment

ID: 22712320
I am trying to upload a zip file with all the code, but i got a message that .accdb extension is not supported
The Eight Noble Truths of Backup and Recovery

How can IT departments tackle the challenges of a Big Data world? This white paper provides a roadmap to success and helps companies ensure that all their data is safe and secure, no matter if it resides on-premise with physical or virtual machines or in the cloud.


Author Comment

ID: 22712501
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
LVL 44

Expert Comment

ID: 22713550
rather than emailing me the database, simply attach the mdb as a file to this site.  That way, others can contribute to the discussion.
LVL 44

Accepted Solution

Arthur_Wood earned 250 total points
ID: 22713604
By changing to "As Object", you are using 'Late Binding',
Since you are explicitly creating the Exccel instances in your code, declaring the variables as Object will be just fine - you may have a slightly lower performance, but nothing to get overly stressed about.
I would not have been much help, as I do not have Access 2007 on my box, and do not have 'access' to a copy.
LVL 44

Expert Comment

ID: 22754351
Glad to be of assistance.  Hope you now understand about Early and Late binding, and when is a good time to use Late Binding.


Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Form performance table vs. query 27 69
Outlook Automation in Access Using "Find" 2 59
Database (Access Table) Security Access 8 59
Speed up Select Top n... Query 9 37
Preparing an email is something we should all take special care with – especially when the email is for somebody you may not know very well. The pressures of everyday working life stacked with a hectic office environment can make this a real challen…
The Windows Phone Theme Colours is a tight, powerful, and well balanced palette. This tiny Access application makes it a snap to select and pick a value. And it doubles as an intro to implementing WithEvents, one of Access' hidden gems.
In Microsoft Access, learn how to “cascade” or have the displayed data of one combo control depend upon what’s entered in another. Base the dependent combo on a query for its row source: Add a reference to the first combo on the form as criteria i…
Using Microsoft Access, learn some simple rules for how to construct tables in a relational database. Split up all multi-value fields into single values: Split up fields that belong to other things into separate tables: Make sure that all record…

739 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question