Solved

copy form and module

Posted on 2008-10-14
7
979 Views
Last Modified: 2012-06-21
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?

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

Open in new window

0
Comment
Question by:titorober23
  • 4
  • 3
7 Comments
 
LVL 44

Expert Comment

by:Arthur_Wood
Comment Utility
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?
 
AW
0
 

Author Comment

by:titorober23
Comment Utility
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.
0
 

Author Comment

by:titorober23
Comment Utility
I am trying to upload a zip file with all the code, but i got a message that .accdb extension is not supported
0
What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 

Author Comment

by:titorober23
Comment Utility
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
0
 
LVL 44

Expert Comment

by:Arthur_Wood
Comment Utility
rather than emailing me the database, simply attach the mdb as a file to this site.  That way, others can contribute to the discussion.
0
 
LVL 44

Accepted Solution

by:
Arthur_Wood earned 250 total points
Comment Utility
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.
 
AW
0
 
LVL 44

Expert Comment

by:Arthur_Wood
Comment Utility
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
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

This article is a continuation or rather an extension from Cascading Combos (http://www.experts-exchange.com/A_5949.html) and builds on examples developed in detail there. It should be understandable alone, but I recommend reading the previous artic…
In the previous article, Using a Critera Form to Filter Records (http://www.experts-exchange.com/A_6069.html), the form was basically a data container storing user input, which queries and other database objects could read. The form had to remain op…
Learn how to number pages in an Access report over each group. Activate two pass printing by referencing the pages property: Add code to the Page Footers OnFormat event to capture the pages as there occur for each group. Use the pages property to …
In Microsoft Access, learn how to use Dlookup and other domain aggregate functions and one method of specifying a string value within a string. Specify the first argument, which is the expression to be returned: Specify the second argument, which …

728 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

Need Help in Real-Time?

Connect with top rated Experts

14 Experts available now in Live!

Get 1:1 Help Now