UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Docmd.transferdatabase Acexport To A User Defined Location, Access 2010    
 
   
halltribe
post May 28 2020, 01:55 PM
Post#1



Posts: 34
Joined: 6-January 04



Hi all, I'm back again with another conundrum. I would be extremely grateful if someone could help me with a solution to the following:

I have created a database which contains updates for my users. On clicking the command button all objects are transferred to their copy of the database. I need to do this monthly as price lists, staff lists etc. change.

I found some code and amazingly managed to amend it to work in Access 2010 on my local machine, however the database location is hard coded into the module. I need to be able to get the user to navigate to the location of their own database copy. (They may also have renamed the original database I sent them, but if that is too complicated I can ask them to rename it to the default name in the code).

I have attached a copy of my database and have pasted the code below.

Thank you in advance for any help you can offer me. UA is a fantastic resource.

Kind regards
Halltribe



Option Compare Database

'---------------------------------------------------------------------------------------
' Procedure : ExpObj2ExtDb
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Export all the database object to another database
' Copyright : The following may be altered and reused as you wish so long as the
' copyright notice is left unchanged (including Author, Website and
' Copyright). It may not be sold/resold or reposted on other sites (links
' back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sExtDb : Fully qualified path and filename of the database to export the objects
' to.
'
' Usage:
' ~~~~~~
' ExpObj2ExtDb "C:\Users\mickey.mouse\Downloads\databases\PBP Interventions - PBP MAY 2020.accdb"
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' ********************************************************************************
******
' 1 2008-Sep-27 Initial Release
'---------------------------------------------------------------------------------------
Public Sub ExpObj2ExtDb(sExtDb As String)
On Error GoTo Error_Handler
Dim dbsCurrent As Database
Dim qdf As QueryDef
Dim tdf As TableDef
Dim obj As AccessObject

Set dbsCurrent = CurrentDb


' Forms.
For Each obj In CurrentProject.AllForms
DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\Users\mickey.mouse\Downloads\databases\PBP Interventions - PBP MAY 2020.accdb", _
acForm, "Welcome", "Welcome", False
Next obj


' Macros.
For Each obj In CurrentProject.AllMacros
DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\Users\mickey.mouse\Downloads\databases\PBP Interventions - PBP MAY 2020.accdb", _
acMacro, obj.Name, obj.Name, False
Next obj

' Modules.
For Each obj In CurrentProject.AllModules
DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\Users\mickey.mouse\Downloads\databases\PBP Interventions - PBP MAY 2020.accdb", _
acModule, obj.Name, obj.Name, False
Next obj

' Queries.
For Each qdf In dbsCurrent.QueryDefs
If Left(qdf.Name, 1) <> "~" Then
DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\Users\mickey.mouse\Downloads\databases\PBP Interventions - PBP MAY 2020.accdb", _
acQuery, qdf.Name, qdf.Name, False
End If

Next qdf

' Reports.
For Each obj In CurrentProject.AllReports
DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\Users\mickey.mouse\Downloads\databases\PBP Interventions - PBP MAY 2020.accdb", _
acReport, obj.Name, obj.Name, False
Next obj

' Tables.
For Each tdf In dbsCurrent.TableDefs
If Left(tdf.Name, 4) <> "MSys" Then 'Ignore/Skip system tables
DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\Users\mickey.mouse\Downloads\databases\PBP Interventions - PBP MAY 2020.accdb", _
acTable, tdf.Name, tdf.Name, False
End If
Next tdf

MsgBox ("The Database has been successfully updated")

Error_Handler_Exit:
On Error Resume Next
Set qdf = Nothing
Set tdf = Nothing
Set obj = Nothing
Exit Sub

Error_Handler:
MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: ExpObj2ExtDb" & vbCrLf & _
"Error Description: " & Err.Description, _
vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit


End Sub


Attached File(s)
Attached File  PBP_June_Update___UA.zip ( 537.37K )Number of downloads: 1
 
Go to the top of the page
 
theDBguy
post May 28 2020, 01:59 PM
Post#2


UA Moderator
Posts: 78,506
Joined: 19-June 07
From: SunnySandyEggo


Hi. If you want the user to be able to select the file name and path, try using the FileDialog object.

--------------------
Just my 2 cents... "And if I claim to be a wise man, it surely means that I don't know" - Kansas
Access Website | Access Blog | Email
Go to the top of the page
 
halltribe
post May 28 2020, 02:19 PM
Post#3



Posts: 34
Joined: 6-January 04



Many thanks for the link.

I'll try to implement it but might be back. Watch this space iconfused.gif
Go to the top of the page
 
theDBguy
post May 28 2020, 02:28 PM
Post#4


UA Moderator
Posts: 78,506
Joined: 19-June 07
From: SunnySandyEggo


Good luck!

--------------------
Just my 2 cents... "And if I claim to be a wise man, it surely means that I don't know" - Kansas
Access Website | Access Blog | Email
Go to the top of the page
 
halltribe
post May 28 2020, 04:50 PM
Post#5



Posts: 34
Joined: 6-January 04



Hi again - I warned you I'd be back lol.

I've been partially successful. My file dialog box seems to be working perfectly (using onclick of a command button). I had to try a few variations as I've learned that it is specific to the object library version.

Selected item's path: C:\users\mickey.mouse\downloads\databases\PBP Interventions - PBP MAY 2020.accdb

I Click OK - then:

The following error has occurred
Error Number: 3024
Error Source: ExpObj2ExtDb
Error Description: Coudl not find file
C:\users\mickey.mouse\downloads\databases\vrtSelectedItem

I assume I am missing something vital that "passes" my path and filename to the public sub which then completes the transfer process.

Thank you once again for any advice.


My new code is shown below:

Option Compare Database

Private Sub cmdPerfUpdate_Click()

'Declare a variable as a FileDialog object.

Dim FD As Office.FileDialog

Set FD = Application.FileDialog(msoFileDialogFilePicker)

'Declare a variable to contain the path 'of each selected item. Even though the path is aString, the variable must be a Variant because For Each...Next
'routines only work with Variants and Objects.

Dim vrtSelectedItem As Variant

'Use a With...End With block to reference the FileDialog object.
With FD

'Allow the user to select multiple files.
.AllowMultiSelect = False

'Use the Show method to display the File Picker dialog box and return the user's action.
'If the user presses the button...
If .Show = -1 Then
'Step through each string in the FileDialogSelectedItems collection.
For Each vrtSelectedItem In .SelectedItems

'vrtSelectedItem is aString that contains the path of each selected item.
'You can use any file I/O functions that you want to work with this path.
'This example displays the path in a message box.
MsgBox "Selected item's path: " & vrtSelectedItem

Next
'If the user presses Cancel...
Else
End If
End With

'Set the object variable to Nothing.
Set FD = Nothing

ExpObj2ExtDb (sExtDb)

End Sub


'---------------------------------------------------------------------------------------
' Procedure : ExpObj2ExtDb
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Export all the database object to another database
' Copyright : The following may be altered and reused as you wish so long as the
' copyright notice is left unchanged (including Author, Website and
' Copyright). It may not be sold/resold or reposted on other sites (links
' back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sExtDb : Fully qualified path and filename of the database to export the objects to.
'
' Usage:
' ~~~~~~
'ExpObj2ExtDb "C:\Users\mickey.mouse\Downloads\databases\PBP Interventions - PBP MAY 2020.accdb"
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' ********************************************************************************
******
' 1 2008-Sep-27 Initial Release
'---------------------------------------------------------------------------------------

Public Sub ExpObj2ExtDb(sExtDb As String)
On Error GoTo Error_Handler
Dim dbsCurrent As Database
Dim qdf As QueryDef
Dim tdf As TableDef
Dim obj As AccessObject
Dim vrtSelectedItem As Variant

Set dbsCurrent = CurrentDb

' Forms.
For Each obj In CurrentProject.AllForms
DoCmd.TransferDatabase acExport, "Microsoft Access", "vrtSelectedItem", acForm, "Welcome", "Welcome", False
Next obj

' Macros.
For Each obj In CurrentProject.AllMacros
DoCmd.TransferDatabase acExport, "Microsoft Access", "vrtSelectedItem", acMacro, obj.Name, obj.Name, False
Next obj

' Modules.
For Each obj In CurrentProject.AllModules
DoCmd.TransferDatabase acExport, "Microsoft Access", "vrtSelectedItem", acModule, obj.Name, obj.Name, False
Next obj

' Queries.
For Each qdf In dbsCurrent.QueryDefs
If Left(qdf.Name, 1) <> "~" Then
DoCmd.TransferDatabase acExport, "Microsoft Access", "vrtSelectedItem", acQuery, qdf.Name, qdf.Name, False
End If

Next qdf

' Reports.
For Each obj In CurrentProject.AllReports
DoCmd.TransferDatabase acExport, "Microsoft Access", "vrtSelectedItem", acReport, obj.Name, obj.Name, False
Next obj

' Tables.
For Each tdf In dbsCurrent.TableDefs
If Left(tdf.Name, 4) <> "MSys" Then 'Ignore/Skip system tables
DoCmd.TransferDatabase acExport, "Microsoft Access", "vrtSelectedItem", acTable, tdf.Name, tdf.Name, False
End If
Next tdf

MsgBox ("The Database has been successfully updated")

Error_Handler_Exit:
On Error Resume Next
Set qdf = Nothing
Set tdf = Nothing
Set obj = Nothing
Set FD = Nothing

Exit Sub

Error_Handler:
MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: ExpObj2ExtDb" & vbCrLf & _
"Error Description: " & Err.Description, _
vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit

End Sub
Go to the top of the page
 
ADezii
post May 28 2020, 05:13 PM
Post#6



Posts: 3,090
Joined: 4-February 07
From: USA, Florida, Delray Beach


The following adjustments should do the trick for you:
CODE
'Must 1st set a Reference to the Microsoft Office XX.X Object Library
Dim dlgOpen As FileDialog
Dim vrtSelectedItem As Variant
Dim strDB As String

Set dlgOpen = Application.FileDialog(msoFileDialogFilePicker)

With dlgOpen
  .AllowMultiSelect = False
  .ButtonName = "Openb DB"
  .InitialView = msoFileDialogViewLargeIcons
  .InitialFileName = CurrentProject.Path
    .Filters.Clear
    .Filters.Add "Databases", "*.mdb; *.accdb"       'Display only *.mdb or *.accdb
      If .Show = -1 Then
        strDB = .SelectedItems(1)       'can do this since can only be 1 File selected
      Else
        Exit Sub    'Nothing selected, so get outta Dodge!
      End If
End With

'Set the Object Variable to Nothing.
Set dlgOpen = Nothing

Call ExpObj2ExtDb(strDB)        'Pass the fully qualified DB Path to the ExpObj2ExtDb() Sub-Routine

This post has been edited by ADezii: May 28 2020, 05:14 PM
Go to the top of the page
 
halltribe
post May 28 2020, 06:27 PM
Post#7



Posts: 34
Joined: 6-January 04



Thank you ADezil for your reply.

I changed my command button code to what you suggested. I now don't receive a confirmation of the path and file name, it goes straight to the error messsage.

The following error has occurred
Error Number: 3024
Error Source: ExpObj2ExtDb
Error Description: Could not find file
C:\users\mickey.mouse\downloads\databases\vrtSelectedItem

(If I remove the Call ExpObj2ExtDb(strdb) from the last line of the command button code, the path and file name appear correctly in the file dialog box).

I have uploaded the latest version of the DB.

My code has been altered as follows:

Private Sub cmdPerfUpdate_Click()
'Must 1st set a Reference to the Microsoft Office XX.X Object Library
Dim dlgOpen As FileDialog
Dim strdb As String

Set dlgOpen = Application.FileDialog(msoFileDialogFilePicker)

With dlgOpen
.AllowMultiSelect = False
.ButtonName = "Open DB"
.InitialView = msoFileDialogViewLargeIcons
.InitialFileName = CurrentProject.Path
.Filters.Clear
.Filters.Add "Databases", "*.mdb; *.accdb"
If .Show = -1 Then
strdb = .SelectedItems(1)
Else
Exit Sub 'Nothing selected, so get outta Dodge!
End If
End With

'Set the object variable to Nothing.
Set dlgOpen = Nothing

Call ExpObj2ExtDb(strdb) 'Pass the fully qualified DB Path to the ExpObj2ExtDb() Sub-Routinethe fully qualified DB Path to the ExpObj2ExtDb() Sub-Routine

End Sub

'---------------------------------------------------------------------------------------
' Procedure : ExpObj2ExtDb
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Export all the database object to another database
' Copyright : The following may be altered and reused as you wish so long as the copyright notice is left unchanged
' (including Author, Website and Copyright).It may not be sold/resold or reposted on other sites (links
' back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sExtDb : Fully qualified path and filename of the database to export the objects to.
'
' Usage:
' ~~~~~~
' ExpObj2ExtDb ExpObj2ExtDb "c:\databases\dbtest.accdb"
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' ********************************************************************************
******
' 1 2008-Sep-27 Initial Release
'---------------------------------------------------------------------------------------

Public Sub ExpObj2ExtDb(sExtDb As String)

On Error GoTo Error_Handler
Dim dbsCurrent As Database
Dim qdf As QueryDef
Dim tdf As TableDef
Dim obj As AccessObject
Dim vrtSelectedItem As Variant

Set dbsCurrent = CurrentDb

' Forms.
For Each obj In CurrentProject.AllForms
DoCmd.TransferDatabase acExport, "Microsoft Access", "vrtSelectedItem", acForm, "Welcome", "Welcome", False
Next obj

' Macros.
For Each obj In CurrentProject.AllMacros
DoCmd.TransferDatabase acExport, "Microsoft Access", "vrtSelectedItem", acMacro, obj.Name, obj.Name, False
Next obj

' Modules.
For Each obj In CurrentProject.AllModules
DoCmd.TransferDatabase acExport, "Microsoft Access", "vrtSelectedItem", acModule, obj.Name, obj.Name, False
Next obj

' Queries.
For Each qdf In dbsCurrent.QueryDefs
If Left(qdf.Name, 1) <> "~" Then
DoCmd.TransferDatabase acExport, "Microsoft Access", "vrtSelectedItem", acQuery, qdf.Name, qdf.Name, False
End If

Next qdf

' Reports.
For Each obj In CurrentProject.AllReports
DoCmd.TransferDatabase acExport, "Microsoft Access", "vrtSelectedItem", acReport, obj.Name, obj.Name, False
Next obj

' Tables.
For Each tdf In dbsCurrent.TableDefs
If Left(tdf.Name, 4) <> "MSys" Then 'Ignore/Skip system tables
DoCmd.TransferDatabase acExport, "Microsoft Access", "vrtSelectedItem", acTable, tdf.Name, tdf.Name, False
End If
Next tdf

MsgBox ("The Database has been successfully updated")

Error_Handler_Exit:
On Error Resume Next
Set qdf = Nothing
Set tdf = Nothing
Set obj = Nothing

Exit Sub

Error_Handler:
MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: ExpObj2ExtDb" & vbCrLf & _
"Error Description: " & Err.Description, _
vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit

End Sub

Attached File(s)
Attached File  PBP_June_Update___UA_V2.zip ( 121.61K )Number of downloads: 1
 
Go to the top of the page
 
halltribe
post May 28 2020, 09:22 PM
Post#8



Posts: 34
Joined: 6-January 04



Finally sorted it.

In my command button private sub
Call ExpObj2ExtDb(strDB) 'Pass the fully qualified DB Path to the ExpObj2ExtDb() Sub-Routine

In my module Public Sub
Public Sub ExpObj2ExtDb(sExtDb As String)

DoCmd.TransferDatabase acExport, "Microsoft Access", "vrtSelectedItem", acTable, tdf.Name, tdf.Name, False 'vrtSelectedItem had been declared as a variant and should not have had quotation marks. (Quotation marks only needed if the full path and file name are used, eg "c:\downloads\mydatabase.accdb").

I have renamed some items and rather than post the full code yet again I have uploaded V3 of the database - a working version.

I hope this helps anyone else who wants to send updates to other users and is struggling. I've learned a lot tonight!!

Thank you UA for yet again pointing me in the right direction.

It's 3.22am. I'm going to bed. Good night all.
Go to the top of the page
 
theDBguy
post May 28 2020, 09:53 PM
Post#9


UA Moderator
Posts: 78,506
Joined: 19-June 07
From: SunnySandyEggo


Hi. Congratulations! Good luck with your project.

--------------------
Just my 2 cents... "And if I claim to be a wise man, it surely means that I don't know" - Kansas
Access Website | Access Blog | Email
Go to the top of the page
 


Custom Search


RSSSearch   Top   Lo-Fi    15th July 2020 - 11:01 PM