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
ASKER
ASKER
ASKER
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
ASKER
ASKER
ASKER
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
You could even stick in a msgbox for debugging to tell you if they exist or not
ASKER
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
ASKER
ASKER
Set objShell = CreateObject("Scripting.FileSystemObject")
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.
ASKER
ASKER
Microsoft Access is a rapid application development (RAD) relational database tool. Access can be used for both desktop and web-based applications, and uses VBA (Visual Basic for Applications) as its coding language.
TRUSTED BY
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