Полный хаос в Excel VBS / SQL

Хорошо, поэтому в моем предыдущем вопросе у меня были проблемы со случайной синтаксической ошибкой. Ну получается код намного хуже, но заполнен тем, что похоже на тот же синтаксис.

Я «унаследовал» этот код и не знаю, как его исправить. Я свежий noob для SQL, но мне явно интересно учиться. На данный момент я, вероятно, заплачу за легкое решение.

Public Code As Integer
Private Sub Workbook_Open()
'this sub resets the worksheet for another PO to be requested

On Error GoTo Catch

Dim Conn
Dim RS
Dim SQL
Dim ActCons As Integer

'open connection to DB
Set Conn = CreateObject("ADODB.Connection")
Conn.Open = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=Purchases;Data Source=tiftonserver;Use Procedure for Prepare=1;Auto "

'recheck # of active sessions in case someone else opened request while filling out this users last request
SQL = "select * from Purchases.dbo.Sessions"
Set RS = Conn.Execute(SQL)
ActCons = RS.Fields(1)

SQL = "select top 1 PONum from Purchases.dbo.POs order by PONum desc"
Set RS = Conn.Execute(SQL)

Range("H12").Value = RS.Fields(0) + ActCons

'unlock user data fields
Worksheets("P.O.").Range("B16:G29").Locked = False
Worksheets("P.O.").Range("F7:H10").Locked = False
Worksheets("P.O.").Range("C12:E12").Locked = False

'clear previous PO request information
Range("B16", "G29").Select
Selection.ClearContents
Range("B34", "G37").Select
Selection.ClearContents
Range("F7").Select
Selection.ClearContents
Range("C12").Select
Selection.ClearContents

'set user name and date based on windows login and date/time
Range("A34").Value = Application.UserName
Range("A38").Value = Date

Range("F7").Select 'set active selection at Vendor

Worksheets("P.O.").Protect UserInterfaceOnly:=True
Exit Sub

Catch:
Set Conn = CreateObject("ADODB.Connection")
Conn.Open = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=Purchases;Data Source=tiftonserver;Use Procedure for Prepare=1;Auto "
SQL = "Update Purchases.dbo.Sessions Set Active = Active - 1"
Set RS = Conn.Execute(SQL)
MsgBox ("An Error has occured and your PO Request has NOT been processed")
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
ThisWorkbook.Close
End Sub


Sub CommandButton1_Click()

'set the filename to be passed to DB_Update
FileName = "\tiftonserverpurchaserequests$" & TextBox1 & ".pdf"
Worksheets("P.O.").Unprotect

Sheets("P.O.").Select
Print_Save
DB_Update (FileName)
Workbook_Open 'reset the workbook for additional POs
Unload Me 'close form for continued use


End Sub



Private Sub CommandButton2_Click()
Unload Me
End Sub

Sub Print_Save()

PrintSetting = True
Dim ru As String
'set up server path
ru = "something"
 Range("A1:H39").Select
 Selection.ExportAsFixedFormat Type:=xlTypePDF, _
 FileName:=ru & Range("H12") & ".pdf", _
 Quality:=xlQualityStandard, IncludeDocProperties:=True, _
 IgnorePrintAreas:=False, OpenAfterPublish:=False

PrintSetting = False
End Sub

Sub DB_Update(FileName)

Dim RowCount As Integer
Dim Conn
Dim RS
Dim SQL
Dim Code As Long
Dim Preamble As Long
Dim postamble As Long

'open connection to DB Server
Set Conn = CreateObject("ADODB.Connection")
Conn.Open = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=Purchases;Data Source=tiftonserver;Use Procedure for Prepare=1;Auto "


RowCount = 16
Range("B16:B29").Select 'selects all rows that can have user data
Do While Not IsEmpty(ActiveCell) 'loop until there is a blank line indicating that there are no more line items

desc = Cells(RowCount, 2).Value

 pos = InStr(Cells(RowCount, 2).Value, "'") > 0
  If pos <> 0 Then
     desc = Replace(Cells(RowCount, 2).Value, "'", "''")
  End If

'create the SQL Query statement to add the PO Details to DB
    SQL = "insert into Purchases.dbo.PODetails values(" & Range("H12").Value & "," & Cells(RowCount, 1) _
    & "," & Cells(RowCount, 6) & "," & Cells(RowCount, 7) & ",'" & _
    desc & "')"
    Set RS = Conn.Execute(SQL) 'execute the query
    ActiveCell.Offset(1, 0).Select
    RowCount = RowCount + 1
Loop

'create random authorization code for this PO Request.
'generate 2 random numbers and the multiply them together to generate the final code
Randomize
Preamble = Int((99 - 10 + 1) * Rnd + 10) * 3
postamble = Int((9999 - 1000 + 1) * Rnd + 1000)
Code = Preamble * postamble

'insert the new PO Request summary into the DB including the authorization code
Dim Report As Worksheet
Set Report = Excel.ActiveSheet
SQL = "insert into Purchases.dbo.POs values(" & Range("H12").Value & "," & Range("H30").Value & "," & Excel.WorksheetFunction.Sum(Report.Range("F16:F29")) & ",'" & Range("A34").Value & _
"','" & Range("F7").Value & "','" & Range("C12").Value & "','" & Range("A38").Value & ",0," & Code & ")"
'MsgBox SQL
Set RS = Conn.Execute(SQL)

'lookup on hidden worksheet that references all user names with their email prefix
Email = Application.WorksheetFunction.VLookup(Range("A34"), Worksheets("Emails").Range("A2:B25").Value, 2, False)
Email = Email & "@someplace.com"
'extract just the PO Request number from the filename passed from Command_Click Sub
PO = Left(FileName, Len(FileName) - 4)
EmailPO = Right(PO, Len(PO) - 33)

'set up the email object to send the PDF of the request and the authorization code
Set emailObj = CreateObject("CDO.Message")
emailObj.From = "NoReply@someplace.com"
emailObj.To = "diego.e@someplace.com"
emailObj.Subject = "PO Request"
'set the msg to send as a mailto hyperlink that will create a new msg to send approval to the correct person automatically
emailObj.TextBody = "mailto:" & Email & "?subject=PO#" & EmailPO & "&Body=Approval_Code:" & Code
emailObj.AddAttachment FileName

'configure the email server information
Set emailConfig = emailObj.Configuration

'Perform email setup tasks

emailObj.Send

If Err.Number = 0 Then
    MsgBox "Your PO request has been processed and sent via email"
    Else: MsgBox "An ERROR has occured."
End If
End Sub

'prevent users from using the 'X' to close forms. They must use the command buttons
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then Cancel = True
End Sub

Я извиняюсь за огромное количество кода, и если кто-нибудь знает лучший способ, скажите, пожалуйста. SMSS кричит на меня. :(