Making Directories and downloading via code

[pbrown77]

Here is the problem. With 3 facility options (TN, MS and TN&MS), 31 reports and 5 different ways a report can be ran (Direct, SDirect, Maintenance, PreAct, All Labor) there are 465 possible reports. At first I was simply going to download all reports into one folder, however searching for a particular report would be rather difficult. Therefore, I have decided to break it down like

June-2005(or current month)\Facility name (TN,MS or TNMS)\Labor Type (Dir,SD,Main,PA or All)\file.snp

This way all TN reports will be under TN and all TN direct will be under TN\Direct\file.snp, all TN SDirect will be under TN\SD\file.snp

Therefore I have tried the following code. The problem is that after the first section which happens to be TN\Direct\file.snp is created it gives the error that I have ran out of temp disk space to create any more items.

Any help would be greatly appreciated!

Private Sub Command69_Click()
Dim strWhere As String
Dim strwhere1 As String
Dim strwhere2 As String
Dim mdofreport As String
Dim dirDate1 As String
Dim dirfac As String
Dim dirmp As String
Dim intLoc As Integer
Dim intLab As Integer

'3 variable array (starts at 0)
Dim strLocation(2) As String

'5 variable array (starts at 0)
Dim strLabor(4) As String


strLocation(0) = "([CC Summary 2nd Level] = 1340) OR " _
& "([CC Summary 2nd Level] > 3999 AND " _
& "[CC Summary 2nd Level] <> 9500 AND " _
& "[CC Summary 2nd Level] Not Between 7700 And 7799)"

strLocation(1) = "([CC Summary 2nd Level] In (1350, 1800, 1801, 1805, 1905, 9500)) OR " _
& "([CC Summary 2nd Level] Between 3000 and 3999) OR " _
& "([CC Summary 2nd Level] Between 7700 and 7799)"

strLocation(2) = "([CC Summary 2nd Level] In (1340, 1350, 1800, 1801, 1805, 1905, 9500)) OR " _
& "([CC Summary 2nd Level] Between 3000 and 7999)"

strLabor(0) = "([Labor Code] In ('D', 'P', 'K', 'H', 'J', 'E', 'N'))"
strLabor(1) = "([Labor Code] In ('G', 'Q'))"
strLabor(2) = "([Labor Code] In ('R', 'L', 'O', 'F'))"
strLabor(3) = "([Labor Code] In ('V', 'Y', 'X'))"
strLabor(4) = "([Labor Code] In ('D', 'P', 'K', 'H', 'J', 'E', 'N', 'G', 'Q', 'R', 'L', 'O', 'F', 'V', 'Y', 'X'))"

For intLoc = 0 To 2

Select Case intLoc

Case 0
gstrRTitle = "Smyrna - Decherd"
Case 1
gstrRTitle = "Canton"
Case 2
gstrRTitle = "Smyrna - Decherd - Canton"



End Select

For intLab = 0 To 4

Select Case intLab

Case 0
gstrTitle = "Direct Manpower"
Case 1
gstrTitle = "SemiDirect Manpower"
Case 2
gstrTitle = "Maintenace Manpower"
Case 3
gstrTitle = "PreAct Manpower"
Case 4
gstrTitle = "All Manpower"

End Select

strWhere = "(" & strLabor(intLab) & ") AND (" & strLocation(intLoc) & ")"
Dim myDir1
Dim myDir2
Dim mydir3



'mdofreport = Format([EndDate], "mm-dd-yyyy")
dirfac = gstrRTitle
dirmp = gstrTitle


dirDate1 = Format([EndDate], "mmmm-yyyy")
myDir1 = Dir("I:\Paul\Monthly Attendance Reports\" & dirDate1, vbDirectory)
If myDir1 = "" Then
MkDir ("I:\Paul\Monthly Attendance Reports\" & dirDate1)
End If
myDir2 = Dir("I:\Paul\Monthly Attendance Reports\" & dirDate1 & "\" & dirfac, vbDirectory)
If myDir2 = "" Then
MkDir ("I:\Paul\Monthly Attendance Reports\" & dirDate1 & "\" & dirfac)
End If
mydir3 = Dir("I:\Paul\Monthly Attendance Reports\" & dirDate1 & "\" & dirfac & "\" & dirmp, vbDirectory)
If myDir2 = "" Then
MkDir ("I:\Paul\Monthly Attendance Reports\" & dirDate1 & "\" & dirfac & "\" & dirmp)
End If
'** The following if statement is repeated for each of the 31 reports **
If DCount("*", "Query for All Reports", strWhere) <> 0 Then
DoCmd.OpenReport "A - Attendance Summary by Plant", acViewPreview, , strWhere
DoCmd.OutputTo acOutputReport, "A - Attendance Summary by Plant", acFormatSNP, "I:\Paul\Monthly Attendance Reports\" & dirDate1 & "\" & dirfac & "\" & dirmp & "\Attendance Summary by Plant" & " " & gstrRTitle & " " & gstrTitle & ".snp"
DoCmd.Close acReport, "A - Attendance Summary by Plant"
End If

Next intLab
Next intLoc
End Sub

 

[KenReay]

Hi

Could it simply be that you haev run out of disk space (or since it is a network drive) have exceeded your quota

Regards

Ken Reay
Freelance Solutions Developer
Boldon Information Systems Ltd
Website needs upgrading, but for now -

http://www.kenneth.reay.btinternet.co.uk

UK