Issue Creating Folder (1 Viewer)

[Dinger_80]

at i have is a user form that is used for requesting work in out test lab. When a user clicks submit the system does things like ensure that the test request number is unique, checks to see if the user is resubmitting a test request, checks for blank fields, and eventually creates a folder on the server with a PDF of the test request and copies a word document into the folder. The code that I use to create a folder on the server is used else where in my database and it works just fine. For some reason it doesn't work here. Also when I execute this code I get an error 91, Object variable or With block variable not set. I have an error handler in place. When I take it away to find the line of code creating the issue the error doesn't occur and my code just stops with out any reason that I can see. I was hoping to get some advice on what may be wrong. As my code is now this is how it looks.


Private Sub SubmitTestRequest_Click()
On Error GoTo ErrorHandler
Dim TRNumber, ProductName, Requestor, TestType, TRNYear As String 'Relate to fields on the form
Dim ToPath, TestPath, CompletedPath As String 'Relate to locations on the server
Dim FileCheck, Worksheet, MyFileName As String 'Relate to actual files not folders
Dim MsgStr1, MsgStr2, MsgStr3 As String 'Repeat messages used
Dim ReportType As String 'The type of report used
Dim Technician As String 'The Tech who may have worked on Test Request
Dim FSO As Object
Dim Counter As String 'The yearly Counter
Dim Day1 As String 'The Day the test request wass requested
Dim Hyper As String 'The Hyperlink that will be sent out
Dim TRNumber2 As String 'If the need for another test request arises
Dim Arrival As String 'A simplified sample arrival text
Dim Destination As String 'Where things are from
Me.TestRequestor.SetFocus
Requestor = Me.TestRequestor.Text
Me.ProductName.SetFocus
ProductName = Me.ProductName.Text
Me.TypeOfTest.SetFocus
TestType = Me.TypeOfTest.Text
MsgStr1 = " field has not been filled in. Please fill this field in before submitting the test request."
MsgStr2 = "The test request you are attempting to resubmit has already had a report started for it or has been marked as completed. Do you wish to continue?"
Me.TRNumber.SetFocus
If DLookup("TRNumber", "DuplicatePreviousTRNumberQuery") = Me.TRNumber.Text Then
If DLookup("IsSubmitted", "DuplicatePreviousTRNumberQuery") = True Then

TRNumber = Me.TRNumber.Text
TRNYear = Left(TRNumber, 4)
CompletedPath = DLookup("CompletedServerDesitnation", "ServerDestinationPreviousTRQuery") & "\" & TRNYear & "\" & TRNumber

Set FSO = CreateObject("scripting.filesystemobject")
If FSO.FolderExists(ToPath) Or FSO.FolderExists(CompletedPath) Then
If MsgBox("Have you modified the original Test Request and resubmitting it?", vbQuestion + vbYesNo, "Resubmitting") = vbNo Then
Counter = DLookup("MaxOfTRNumberCounter", "TRNCounterQuery") + 1
Day1 = Format(Now, "yyyymmdd")
TRNumber = Day1 & "-" & Counter
Hyper = "#" & Destination & TRNumber & "#"

Me.TRNumberCounter.Visible = True
Me.TRNumberCounter.SetFocus
Me.TRNumberCounter.Text = ""
Me.TRNumberCounter.Text = Counter
Me.FolderHyperLink.Visible = True
Me.FolderHyperLink.SetFocus
Me.TRNumberCounter.Visible = False
Me.FolderHyperLink.Text = ""
Me.FolderHyperLink.Text = Hyper
Me.TRNumber.Locked = False
Me.TRNumber.SetFocus
Me.FolderHyperLink.Visible = False
Me.TRNumber.Text = TRNumber
Me.TRNumber.Locked = True
Else

FileCheck = CompletedPath & "\" & TRNumber & " Report" & ".pdf"

If FSO.FileExists(FileCheck) Or FSO.FolderExists(CompletedPath) Then
If MsgBox(MsgStr2, vbExclamation + vbYesNo, "Resubmitting", , VbMsgBoxStyle.vbExclamation) = vbYes Then
Kill (CompletedPath & "\" & TRNumber & ".PDF")

DoCmd.OpenReport "TestRequestReport", acViewPreview, , "[TRNumber]= Forms!PreviousTestRequestForm!TRNumber"
DoCmd.OutputTo acOutputReport, "TestRequestReport", acFormatPDF, CompletedPath & "\" & TRNumber & ".PDF", False
DoCmd.Close acReport, "TestRequestReport"

Call OtherEmail
Exit Sub
Else
MsgBox "The Test Request on the server has not been updated."
Exit Sub
End If
End If

Destination = DLookup("InitialServerDestination", "ServerDestinationPreviousTRQuery")
ToPath = Destination & TRNumber
MyFileName = TRNumber & ".pdf"

Kill (ToPath & "\" & MyFileName)
DoCmd.OpenReport "TestRequestReport", acViewPreview, , "[TRNumber]= Forms!PreviousTestRequestForm!TRNumber"
DoCmd.OutputTo acOutputReport, "TestRequestReport", acFormatPDF, ToPath & "\" & MyFileName, False
DoCmd.Close acReport, "TestRequestReport"

Call ResubmittingEmail
Exit Sub

End If
End If
End If
Else
Me.TRNumber.SetFocus
TRNumber = Me.TRNumber.Text
End If
Destination = DLookup("InitialServerDestination", "ServerDestinationPreviousTRQuery")
Worksheet = Destination & "WORKSHEET.docx"
ToPath = Destination & TRNumber
MyFileName = TRNumber & ".pdf"
FileCheck = ToPath & "\" & TRNumber & " Report" & ".pdf"
TestPath = Destination & MyFileName
'Here is where the Test Location is checked
If Me.TestingElseWhere = True Then
Me.TestLocation.SetFocus
If Me.TestLocation.Text = "" Then
MsgBox "The Test Location" & MsgStr1, VbMsgBoxStyle.vbExclamation
Exit Sub
End If
End If
If Me.TestingElseWhere = True Then
Me.TestLocation.SetFocus
If Me.TestLocation.Column(1) <> DLookup("FacilityLocation", "GetUserLocationQuery") Then
Destination = DLookup("InitialServerDestination", "ServerDestinationPreviousTRQuery")
Me.TRNumber.Locked = False
Counter = DLookup("MaxOfTRNumberCounter", "ServerDestinationPreviousTRQuery") + 1
Day1 = Format(Now, "yyyymmdd")
TRNumber2 = Day1 & "-" & Counter
Hyper = "#" & Destination & TRNumber2 & "#"

Me.TRNumberCounter.Visible = True
Me.TRNumberCounter.SetFocus
Me.TRNumberCounter.Text = Counter
Me.TRNumber.Locked = False
Me.TRNumber.SetFocus
Me.TRNumberCounter.Visible = False
Me.TRNumber.Text = TRNumber2
Me.TRNumber.Locked = True
Me.FolderHyperLink.Visible = True
Me.FolderHyperLink.SetFocus
Me.FolderHyperLink.Text = Hyper
Me.TypeOfTest.SetFocus
Me.FolderHyperLink.Visible = False
Else
Destination = DLookup("InitialServerDestination", "ServerDestinationPreviousTRQuery")
End If
Else
Destination = DLookup("InitialServerDestination", "ServerDestinationPreviousTRQuery")
End If
Me.DateRequired.SetFocus
If Me.DateRequired.Text = "" Then
MsgBox "The Date Required" & MsgStr1, VbMsgBoxStyle.vbExclamation
Exit Sub
End If
Me.IntervalsNumber.SetFocus
If Me.IntervalsNumber.Text = "" Then
MsgBox "The Intervals Number" & MsgStr1, VbMsgBoxStyle.vbExclamation
Exit Sub
End If
Me.IntervalsModule.SetFocus
If IntervalsModule.Text = "" Then
MsgBox "Intervals Module" & MsgStr1, VbMsgBoxStyle.vbExclamation
Exit Sub
End If
Me.SampleArrivalDate.SetFocus
Arrival = Me.SampleArrivalDate.Text
If SampleArrivalDate.Text = "" Then
MsgBox "Sample Arrival" & MsgStr1, VbMsgBoxStyle.vbExclamation
Exit Sub
Else
Me.DateRequired.SetFocus
If Arrival > Me.DateRequired.Text Then
MsgBox "The arrival date of the sample is after the test is due. Please adjust your Date Required before submitting the Test Request."
Exit Sub
End If
End If
Me.SampleDisposal.SetFocus
If SampleDisposal.Text = "" Then
MsgBox "Sample Disposal" & MsgStr1, VbMsgBoxStyle.vbExclamation
Exit Sub
Else
If SampleDisposal.Text = "Witness()" And Me.WitnessTesting = False Then
If MsgBox("You have selected Witness Disposal yet haven't selected Witness testing. Was this done intentionally?", vbQuestion + vbYesNo) = vbNo Then
Me.WitnessTesting = True
End If
End If

If Me.SampleDisposal.Text = "Client Test (1 Year)" And Me.WitnessTesting = False Then
If MsgBox("You have selected Client Test yet haven't selected Witness testing. Was this done intentionally?", vbQuestion + vbYesNo) = vbNo Then
Me.WitnessTesting = True
End If
End If
End If
Me.TypeOfTest.SetFocus
If TypeOfTest.Text = "" Then
MsgBox "Type of Test " & MsgStr1, VbMsgBoxStyle.vbExclamation
Exit Sub
End If
Me.CatalogNumber.SetFocus
If Me.CatalogNumber.Text = "" Then
MsgBox "The Catalog Combo" & MsgStr1, VbMsgBoxStyle.vbExclamation
Exit Sub
End If
Me.TestCatagory1.SetFocus
If TestCatagory1.Text = "" Then
MsgBox "Please select a test catagory from Test Catagory 1", VbMsgBoxStyle.vbExclamation
Exit Sub
End If
If Me.TestCatagory1.Text = "Quality Control" Then
Me.QualityAssuranceNumber.SetFocus
If Me.QualityAssuranceNumber.Text = "" Then
MsgBox "The Quality Assurance Number" & MsgStr1, VbMsgBoxStyle.vbExclamation
Exit Sub
End If
End If
Me.TestCatagory2.SetFocus
If TestCatagory2.Text = "" Then
MsgBox "Please select a test catagory from Test Catagory 2", VbMsgBoxStyle.vbExclamation
Exit Sub
End If
Me.PurposeOfTest.SetFocus
If PurposeOfTest.Text = "" Then
MsgBox "Purpose of Test Box" & MsgStr1, VbMsgBoxStyle.vbExclamation
Exit Sub
Else
With Me!PurposeOfTest
Me!PurposeOfTest.SetFocus
If Len(.Value) > 0 Then
DoCmd.SetWarnings False
.SelStart = 1
.SelLength = Len(.Value)
DoCmd.RunCommand acCmdSpelling
.SelLength = 0
DoCmd.SetWarnings True
End If
End With
End If
Me.SpecialProcedures.SetFocus
If SpecialProcedures.Text = "" Then
MsgBox "Special Procedures" & MsgStr1, VbMsgBoxStyle.vbExclamation
Exit Sub
Else
With Me!SpecialProcedures
Me!SpecialProcedures.SetFocus
If Len(.Value) > 0 Then
DoCmd.SetWarnings False
.SelStart = 1
.SelLength = Len(.Value)
DoCmd.RunCommand acCmdSpelling
.SelLength = 0
DoCmd.SetWarnings True
End If
End With
End If
If Me.IndividualComponent = True Then
Me.ComponentCombo.SetFocus
If Me.ComponentCombo.Text = "Fixture" Then
MsgBox "You have selected that an individual component will be tested, however you have selected fixture as the part being tested. Please choose " & _
"a different item other then the fixture for testing."
Exit Sub
End If

If Me.ComponentCombo.Text <> "Prototype" Then
Me.ComponentTested.SetFocus
If Me.ComponentTested.Text = "" Then
MsgBox "The Model Number" & MsgStr1, VbMsgBoxStyle.vbExclamation
Exit Sub
End If

Me.ComponentManufacturer.SetFocus
If Me.ComponentManufacturer.Text = "" Then
MsgBox "The Component Manufacturer" & MsgStr1, VbMsgBoxStyle.vbExclamation
Exit Sub
End If
End If
End If
If Me.WitnessTesting = True Then
If Me.WitnessAgency.Enabled = True Then
Me.WitnessAgency.SetFocus
If Me.WitnessAgency.Text <> "Other" Then
If Me.WitnessAgency.Text = "" Then
MsgBox "Witness Agency" & MsgStr1, VbMsgBoxStyle.vbExclamation
Exit Sub
End If

Me.FileNumber.SetFocus
If Me.FileNumber.Text = "" Then
MsgBox "The File Number" & MsgStr1, VbMsgBoxStyle.vbExclamation
Exit Sub
End If

Me.ProjectNumber.SetFocus
If Me.ProjectNumber.Text = "" Then
MsgBox "The Project Number" & MsgStr1, VbMsgBoxStyle.vbExclamation
Exit Sub
End If
End If
Else
MsgBox "You have selected Witness Testing, however you do not have the rights to fill in the appropriate text boxes. In order to properly " & _
"submit this test request a Certs Engineer will need to finish filling in the Witness section."
DoCmd.RunCommand acCmdSave
Exit Sub
End If
End If
'Here the record is saved
Me.Refresh
'Here the folder is created, the pdf, and the worksheet is copied into the folder
Set FSO = CreateObject("scripting.filesystemobject")
FSO.CreateFolder (ToPath)
DoCmd.OpenReport "TestRequestReport", acViewPreview, , "[TRNumber]= Forms!TestRequestForm!TRNumber"
DoCmd.OutputTo acOutputReport, "TestRequestReport", acFormatPDF, ToPath & "\" & MyFileName, False
DoCmd.Close acReport, "TestRequestReport"
FSO.CopyFile Source:=Worksheet, Destination:=ToPath & "\WORKSHEET.docx"

 

[MarkK]

That routine is way too long. Break it up into meaningfully named subroutines. For instance, this block . . .

Me.TRNumberCounter.Visible = True
Me.TRNumberCounter.SetFocus
Me.TRNumberCounter.Text = ""
Me.TRNumberCounter.Text = Counter
Me.FolderHyperLink.Visible = True
Me.FolderHyperLink.SetFocus
Me.TRNumberCounter.Visible = False
Me.FolderHyperLink.Text = ""
Me.FolderHyperLink.Text = Hyper
Me.TRNumber.Locked = False
Me.TRNumber.SetFocus
Me.FolderHyperLink.Visible = False
Me.TRNumber.Text = TRNumber
Me.TRNumber.Locked = True

. . . should be in a subroutine. Also, you don't have to keep moving the focus like that. Just move it once.

Also, don't exit a sub in the middle. If you find that you want to have an Exit Sub in the middle of the routine, the routine is too long, or your logic is not efficient.

Hope this helps,

 

[Dinger_80]

How would I go about breaking the code down into a sub routine? The reason that I put exit subs in there was because I have the system checking things with the use or checking the form. If certain criteria isn't met then I don't want to code to continue. So what recommendations would you offer then to stop the code from continuing?

 

[spikepl]

Do not use the Text property of a textbox or combobox - that requires setting focus on the control. Me.MyCOntrolName=Somevalue is adequate.

The only reason for assigning values to the Text property would be to trigger the AfterUpdate event of the control, when the control looses focus, but that can be accomplished by calling the control's AfterUpdate explictly.

Update: You display too much code for it to be readable ... so display it like everybody else, in code tags. Trick question: How?

 

[MarkK]

Right, that's why all the setfocus's. What spike says is right, set the .Value property of the control, not .Text.

You don't need Exit Subs because you can use an If...ElseIf...End If. Consider this code . . .

Sub Testing123
   If SomeCondition Then
      DoSomething
   ElseIf SomeOtherCondition Then
      DoSomethingOther
   ElseIf SomeOtherOtherCondition Then
      DoSomethingOtherThing
   Else
      DoSomethingElse
   End If
End Sub

The If...ElseIf...End If block, by definition, only executes one of the options. The code will then exit normally without Exit Sub.

 

[MarkK]

This block occurs at least three times in your code.

DoCmd.OpenReport "TestRequestReport", acViewPreview, , "[TRNumber]= Forms!PreviousTestRequestForm!TRNumber"
DoCmd.OutputTo acOutputReport, "TestRequestReport", acFormatPDF, ToPath & "\" & MyFileName, False
DoCmd.Close acReport, "TestRequestReport"

Put this code in ONE subroutine, and give that subroutine a very descriptive name. Then your code becomes self-documenting, and it becomes less cluttered, and there are fewer places for bugs to hide.

Hope this helps,

 

[Dinger_80]

Ok I think I understand what you are suggesting for the length of the code. If i am wrong please point me in the right direction. I should break some of the code off into fuctions as I am looking for a result. Then to avoid a exit sub put things into a big "If" statement as many results could be returned? I am still doing some research on the Tags. They are a big higher over my head and will take a little while to fully comprehend. I just want to say thank you all help on this. I haven't had to do large amounts of programing before and I find all thoughts have value.

 

[MarkK]

Right on, feel free to post other questions, or more code for more comments if you want. All the best,

 

[Dinger_80]

Is there a way to pass the err.number & err.description to a function. For example On error goto errorhandlersome codeErrorhandler:Call errorhandler functionI tried something along those lines and it sets the err.number & err.description to 0.

 

[MarkK]

If you post the exact code we can troubleshoot it. Also, when you post code use code tags, so highlight the code, and then hit the number sign on the toolbar, above. That offsets it and preserves the indents and so on, like . . .

Private Sub ThisIsTaggedCode()
    MsgBox "See how readable this is?", vbInformation
End Sub

There is only one possible instance of the VBA.ErrObject object. If you enable a new error handler, or use Resume, or Clear, and possibly other error commands, the error object is reset.

 

[Dinger_80]

Cool thanks for the help. I will keep that in mind for the future. I was just trying to elimate duplicate code and simplify things that can be simplified.