backing up the code mods

  • Thread starter Thread starter JohnE
  • Start date Start date
J

JohnE

Hello. I have a situation in which I have backed up the code modules using
the code below that I found. It worked fine in A2003 and A2007 but now I get
an error message and #2950 in both A2003 and A2007. The line in which it
errors out on is so marked (fails here -- >). I am at a loss as to why now
this is occurring. Can anyone determine what is going wrong here?

Thanks.

Public Function exportModules(sDestPath As String) As Boolean

On Error GoTo ErrHandler

Dim recSet As Recordset
Dim frm As Form
Dim rpt As Report
Dim sqlStmt As String
Dim sObjName As String
Dim idx As Long
Dim fOpenedRecSet As Boolean

'--------------------------------------------------------------
' Ensure that there's a backslash at the end of the path.
'--------------------------------------------------------------

If (Mid$(sDestPath, Len(sDestPath), 1) <> "\") Then
sDestPath = sDestPath & "\"
End If

'--------------------------------------------------------------
' Export standard modules and classes.
'--------------------------------------------------------------

sqlStmt = "SELECT [Name] " & _
"FROM MSysObjects " & _
"WHERE ([Type] = -32761);"

Set recSet = CurrentDb().OpenRecordset(sqlStmt)
fOpenedRecSet = True

If (Not (recSet.BOF And recSet.EOF)) Then
recSet.MoveLast
recSet.MoveFirst

For idx = 1 To recSet.RecordCount
fails here --> SaveAsText acModule, recSet.Fields(0).Value,
sDestPath & recSet.Fields(0).Value & ".inc"

If (Not (recSet.EOF)) Then
recSet.MoveNext
End If

Next idx

End If

'--------------------------------------------------------------
' Export form modules.
'--------------------------------------------------------------

sqlStmt = "SELECT [Name] " & _
"FROM MSysObjects " & _
"WHERE ([Type] = -32768);"

Set recSet = CurrentDb().OpenRecordset(sqlStmt)
fOpenedRecSet = True

If (Not (recSet.BOF And recSet.EOF)) Then
recSet.MoveLast
recSet.MoveFirst

For idx = 1 To recSet.RecordCount
sObjName = recSet.Fields(0).Value
DoCmd.OpenForm sObjName, acDesign
Set frm = Forms(sObjName)

If (frm.HasModule) Then
DoCmd.OutputTo acOutputModule, "Form_" & sObjName,
acFormatTXT, sDestPath & sObjName & ".inc"
End If

DoCmd.Close acForm, sObjName

If (Not (recSet.EOF)) Then
recSet.MoveNext
End If
Next idx
End If

'--------------------------------------------------------------
' Export report modules.
'--------------------------------------------------------------

sqlStmt = "SELECT [Name] " & _
"FROM MSysObjects " & _
"WHERE ([Type] = -32764);"

Set recSet = CurrentDb().OpenRecordset(sqlStmt)
fOpenedRecSet = True

If (Not (recSet.BOF And recSet.EOF)) Then
recSet.MoveLast
recSet.MoveFirst

For idx = 1 To recSet.RecordCount
sObjName = recSet.Fields(0).Value
DoCmd.OpenReport sObjName, acDesign
Set rpt = Reports(sObjName)

If (rpt.HasModule) Then
DoCmd.OutputTo acOutputModule, "Report_" & sObjName,
acFormatTXT, sDestPath & sObjName & ".inc"
End If

DoCmd.Close acReport, sObjName

If (Not (recSet.EOF)) Then
recSet.MoveNext
End If

Next idx

End If

exportModules = True ' Success.

CleanUp:

If (fOpenedRecSet) Then
recSet.Close
fOpenedRecSet = False
End If

Set frm = Nothing
Set rpt = Nothing
Set recSet = Nothing

Exit Function

ErrHandler:

MsgBox "Error in exportModules( )." & vbCrLf & vbCrLf & "Error #" &
err.Number & vbCrLf & vbCrLf & err.Description
err.Clear
exportModules = False ' Failed.
GoTo CleanUp

Resume

End Function ' exportModules( )
 
Nevermind. I finally got it figured out and working.
Thanks for reviewing the post.
.... John



JohnE said:
Hello. I have a situation in which I have backed up the code modules using
the code below that I found. It worked fine in A2003 and A2007 but now I get
an error message and #2950 in both A2003 and A2007. The line in which it
errors out on is so marked (fails here -- >). I am at a loss as to why now
this is occurring. Can anyone determine what is going wrong here?

Thanks.

Public Function exportModules(sDestPath As String) As Boolean

On Error GoTo ErrHandler

Dim recSet As Recordset
Dim frm As Form
Dim rpt As Report
Dim sqlStmt As String
Dim sObjName As String
Dim idx As Long
Dim fOpenedRecSet As Boolean

'--------------------------------------------------------------
' Ensure that there's a backslash at the end of the path.
'--------------------------------------------------------------

If (Mid$(sDestPath, Len(sDestPath), 1) <> "\") Then
sDestPath = sDestPath & "\"
End If

'--------------------------------------------------------------
' Export standard modules and classes.
'--------------------------------------------------------------

sqlStmt = "SELECT [Name] " & _
"FROM MSysObjects " & _
"WHERE ([Type] = -32761);"

Set recSet = CurrentDb().OpenRecordset(sqlStmt)
fOpenedRecSet = True

If (Not (recSet.BOF And recSet.EOF)) Then
recSet.MoveLast
recSet.MoveFirst

For idx = 1 To recSet.RecordCount
fails here --> SaveAsText acModule, recSet.Fields(0).Value,
sDestPath & recSet.Fields(0).Value & ".inc"

If (Not (recSet.EOF)) Then
recSet.MoveNext
End If

Next idx

End If

'--------------------------------------------------------------
' Export form modules.
'--------------------------------------------------------------

sqlStmt = "SELECT [Name] " & _
"FROM MSysObjects " & _
"WHERE ([Type] = -32768);"

Set recSet = CurrentDb().OpenRecordset(sqlStmt)
fOpenedRecSet = True

If (Not (recSet.BOF And recSet.EOF)) Then
recSet.MoveLast
recSet.MoveFirst

For idx = 1 To recSet.RecordCount
sObjName = recSet.Fields(0).Value
DoCmd.OpenForm sObjName, acDesign
Set frm = Forms(sObjName)

If (frm.HasModule) Then
DoCmd.OutputTo acOutputModule, "Form_" & sObjName,
acFormatTXT, sDestPath & sObjName & ".inc"
End If

DoCmd.Close acForm, sObjName

If (Not (recSet.EOF)) Then
recSet.MoveNext
End If
Next idx
End If

'--------------------------------------------------------------
' Export report modules.
'--------------------------------------------------------------

sqlStmt = "SELECT [Name] " & _
"FROM MSysObjects " & _
"WHERE ([Type] = -32764);"

Set recSet = CurrentDb().OpenRecordset(sqlStmt)
fOpenedRecSet = True

If (Not (recSet.BOF And recSet.EOF)) Then
recSet.MoveLast
recSet.MoveFirst

For idx = 1 To recSet.RecordCount
sObjName = recSet.Fields(0).Value
DoCmd.OpenReport sObjName, acDesign
Set rpt = Reports(sObjName)

If (rpt.HasModule) Then
DoCmd.OutputTo acOutputModule, "Report_" & sObjName,
acFormatTXT, sDestPath & sObjName & ".inc"
End If

DoCmd.Close acReport, sObjName

If (Not (recSet.EOF)) Then
recSet.MoveNext
End If

Next idx

End If

exportModules = True ' Success.

CleanUp:

If (fOpenedRecSet) Then
recSet.Close
fOpenedRecSet = False
End If

Set frm = Nothing
Set rpt = Nothing
Set recSet = Nothing

Exit Function

ErrHandler:

MsgBox "Error in exportModules( )." & vbCrLf & vbCrLf & "Error #" &
err.Number & vbCrLf & vbCrLf & err.Description
err.Clear
exportModules = False ' Failed.
GoTo CleanUp

Resume

End Function ' exportModules( )
Click to expand...
 
Back
Top