Link to home
Start Free TrialLog in
Avatar of DarrenJackson
DarrenJacksonFlag for United Kingdom of Great Britain and Northern Ireland

asked on

Create Folder in access 2003

Guys

I have a vbscript in access 2003 that apart from other things is supposed to create a folder before it imports the database.

It isnt doing this I have the script which I will attach I believe I am close but not quite there. Can someone please have a look and modify where necessary to allow a folder created before the transfer takes place.

Regards
Private Sub Command5_Click()
On Error GoTo Err_Command5_Click

    Dim stDocName As String
    Dim stDocName1 As String
    Dim appAccess
    Dim strDB As String
    
    strDB = Text52 & "\" & Combo58 & ".mdb"

    stDocName1 = "Deletetion_Ind.Master_Del"
    DoCmd.RunMacro stDocName1
    stDocName = "Master"
    DoCmd.OpenQuery stDocName, acNormal, acEdit
    
    Set appAccess = CreateObject("Access.Application")
   appAccess.NewCurrentDatabase strDB

 appAccess.Quit
   Set appAccess = Nothing

Set objShell = CreateObject("Scripting.FileSystemObject")

Set ofolder = objShell.createfolder(strDB)

objShell.createfolder ofolder

DoCmd.TransferDatabase acExport, "Microsoft Access", strDB, acTable, "Master_tbl", Combo58, False

Exit_Command5_Click:
    Exit Sub

Err_Command5_Click:
    'MsgBox Err.Description
    MsgBox "Please double check that you havent already done this"
    
End Sub

Open in new window

Avatar of andrewssd3
andrewssd3
Flag of United Kingdom of Great Britain and Northern Ireland image

Yes you are nearly there - the problem is that strDB contains the full file name for the new database, and you're trying to create a folder with the whole name.  You need to create a folder with just the folder name.  I'm not sure if you separately need to create the mdb file - I suspect TransferDatabase will do that.

Also bear in mind that CreateFolder won't create multiple levels of directories in one go - so if you want to create something like "c:\master\subdir1\subdir2" where master and subdir2 don't exist, it will fail.
Avatar of DarrenJackson

ASKER

yeah there is a subfolder as well

So how would I go about this

Regards
Of course I meant  'master and subdir1 dont exist' - subdir2 must not exist
ASKER CERTIFIED SOLUTION
Avatar of andrewssd3
andrewssd3
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Ahh ok thanks just going for dinner but will take a look at that in an hour

Thank you
Avatar of Norie
Norie

Darren

What's the name of the folder you are trying to create?

Is it the value in strDB?

Aren't you using that to open a database?

Where are you trying to create it?

I think if you remove the On Error Resume Next then you'll probably find a few problems with the code to create a folder.
imnorie
The folder is on a network share and the user selects from combo boxes to adjust the location which either exists or not
Im not opening the db just exporting the contents of a table to another db

I did remove the On Error and it says the the db already exists but as I cant seem to step through the code i cant even see where it is creating it

Attached is the code with some small changes as per andrewssd3
Private Sub Command5_Click()
On Error GoTo Err_Command5_Click

    Dim stDocName As String
    Dim stDocName1 As String
    Dim appAccess
    Dim strDB1 As String
    Dim strDB2 As String
    Dim strDB3 As String
    
    
    strDB1 = Text65 & "\" & Combo58 & "\"
    strDB2 = Text65 & "\" & Combo58 & "\" & Text50
    strDB3 = Text65 & "\" & Combo58 & "\" & Text50 & "\" & Combo58 & ".mdb"
    'strDB3 = Text52 & "\" & Combo58 & ".mdb"

    stDocName1 = "Deletetion_Ind.Master_Del"
    DoCmd.RunMacro stDocName1
    stDocName = "Master"
    DoCmd.OpenQuery stDocName, acNormal, acEdit
    
    Set appAccess = CreateObject("Access.Application")
   appAccess.NewCurrentDatabase strDB

 appAccess.Quit
   Set appAccess = Nothing

Set objShell = CreateObject("Scripting.FileSystemObject")

Set ofolder = objShell.createfolder(strDB1)
Set ofolder = objShell.createfolder(strDB2)

objShell.createfolder ofolder

DoCmd.TransferDatabase acExport, "Microsoft Access", strDB3, acTable, "Master_tbl", Combo58, False

Exit_Command5_Click:
    Exit Sub

Err_Command5_Click:
    MsgBox Err.Description
    'MsgBox "Please double check that you havent already done this"
    
End Sub

Open in new window

Above code still doesnt work anyone know what I'm doing wrong

Thanks
I don't think you need line 33 any more.  Also are you deleting the created folder between tests - it will error if the subdirectory already exists
Darren

You should check if the directory does exist by navigating to it with Explorer or whatever.

It might be worth checking if any other directories have been created in unexpected places.

As for the code, you need to check the name and path for the folder you are trying to create before you create it.

You can do that by sticking a breakpoint(F9) on the CreateFolder line(s) and running the code.

When the code stops it should be just before the folder is going to be created.

That's when you should check the path and name by looking at the variables strDB1 and strDB2.
Thanks andrew will remove line 33 but as I dont seem to know where the directory is being created I am struggling but I dont want it to error if the directory exists just carry on and then just overwrite the db if that exists

but that part of the code isnt important just yet

Thanks
Darren

You can step through every line of code using F8 if you put a breakpoint on the first line or just hit F8 to start the code.
Yeah normally F8 i would use but it is not working which is odd in it self
You could try
If Not (objShell.FolderExists(strDB1)) Then
Set ofolder = objShell.createfolder(strDB1)
End If
If Not (objShell.FolderExists(strDB2)) Then
Set ofolder = objShell.createfolder(strDB2)
End If

Open in new window

You could even stick in a msgbox for debugging to tell you if they exist or not
Have you tried a breakpoint?

I don't know where the command button is located but if it's on a form set a breakpoint on the button's click event.

Then open/run the form and click the button.

You should then be able to debug.

There are lots of alternative things you could try, the important thing is that the folder path/name needs to be checked to see
if you are using the right values.
Guys when I run the code by itself I get an error saying object doesnt exist but the path is correct that I can see
Private Sub Command67_Click()

Dim stDocName As String
    Dim stDocName1 As String
    Dim appAccess
    Dim strDB1 As String
    Dim strDB2 As String
    Dim strDB3 As String
    
    strDB1 = Text65 & "\" & Combo58 & "\"
    strDB2 = Text65 & "\" & Combo58 & "\" & Text50
    strDB3 = Text65 & "\" & Combo58 & "\" & Text50 & "\" & Combo58 & ".mdb"
    'strDB3 = Text52 & "\" & Combo58 & ".mdb"
    
   If Not (objShell.FolderExists(strDB1)) Then
   Set ofolder = objShell.createfolder(strDB1)
   End If

   If Not (objShell.FolderExists(strDB2)) Then
   Set ofolder = objShell.createfolder(strDB2)
   End If
    

End Sub

Open in new window

it errors at line 15
SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
mmmm Text65 contains the path which is a valid path that doesnt exist but the code is supposed to look at this then create the path

VBA's MkDir actually no i havent do you have any code I could use to see if this will get over my probelm?

Regards
Darren - as inmorie says - you have removed the creation of the FileSystemObject from you code - you need to add in this line again after line 14:
Set objShell = CreateObject("Scripting.FileSystemObject")

Open in new window

There should be no problems with the FileSystemObject way of doing things - Microsoft recommend you use that model rather than the old MkDir, Dir etc - they often don'y work well with recursive processing, etc.
doh  thats worked

I blame fridays ;)

OK I will carry on testing

Thanks
Amazingly it is working a treat thanks guys for your help