Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

copy form and module

Posted on 2008-10-14
7
Medium Priority
?
995 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
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
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 

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 750 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

Vote for the Most Valuable Expert

It’s time to recognize experts that go above and beyond with helpful solutions and engagement on site. Choose from the top experts in the Hall of Fame or on the right rail of your favorite topic page. Look for the blue “Nominate” button on their profile to vote.

Question has a verified solution.

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

We live in a world of interfaces like the one in the title picture. VBA also allows to use interfaces which offers a lot of possibilities. This article describes how to use interfaces in VBA and how to work around their bugs.
Windows Explorer lets you open cabinet (cab) files like any other folder. In VBA you can easily handle normal files and folders, but opening and indeed creating cabinet files takes a lot more - and that's you'll find here.
Visualize your data even better in Access queries. Given a date and a value, this lesson shows how to compare that value with the previous value, calculate the difference, and display a circle if the value is the same, an up triangle if it increased…
Look below the covers at a subform control , and the form that is inside it. Explore properties and see how easy it is to aggregate, get statistics, and synchronize results for your data. A Microsoft Access subform is used to show relevant calcul…

916 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