Solved

copy form and module

Posted on 2008-10-14
7
988 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
[X]
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
7 Comments
 
LVL 44

Expert Comment

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

Author Comment

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

Author Comment

by:titorober23
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
0
Migrating Your Company's PCs

To keep pace with competitors, businesses must keep employees productive, and that means providing them with the latest technology. This document provides the tips and tricks you need to help you migrate an outdated PC fleet to new desktops, laptops, and tablets.

 

Author Comment

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

Expert Comment

by:Arthur_Wood
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.
0
 
LVL 44

Accepted Solution

by:
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.
 
AW
0
 
LVL 44

Expert Comment

by:Arthur_Wood
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.

AW
0

Featured Post

Free learning courses: Active Directory Deep Dive

Get a firm grasp on your IT environment when you learn Active Directory best practices with Veeam! Watch all, or choose any amount, of this three-part webinar series to improve your skills. From the basics to virtualization and backup, we got you covered.

Question has a verified solution.

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

It’s been over a month into 2017, and there is already a sophisticated Gmail phishing email making it rounds. New techniques and tactics, have given hackers a way to authentically impersonate your contacts.How it Works The attack works by targeti…
Did you know that more than 4 billion data records have been recorded as lost or stolen since 2013? It was a staggering number brought to our attention during last week’s ManageEngine webinar, where attendees received a comprehensive look at the ma…
Basics of query design. Shows you how to construct a simple query by adding tables, perform joins, defining output columns, perform sorting, and apply criteria.
In Microsoft Access, when working with VBA, learn some techniques for writing readable and easily maintained code.

617 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