title: Complete chaos in Excel VBS/SQL
body: <p>Ok so in my previous question, I was having issues with a random syntax error. Well turns out the code is much worse, but filled with what seems to be the same syntax. </p>
  
  <p>I "inherited" this code and have 0 idea how to fix it. I'm a fresh noob to SQL but I'm obviously interested in learning. At this point I'd probably pay for an easy solution.</p>
  
  <pre class="lang-vb prettyprint-override"><code>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 " &amp; Err.Number &amp; vbCrLf &amp; Err.Description
  ThisWorkbook.Close
  End Sub
  
  
  Sub CommandButton1_Click()
  
  'set the filename to be passed to DB_Update
  FileName = "\\tiftonserver\purchaserequests$\" &amp; TextBox1 &amp; ".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 &amp; Range("H12") &amp; ".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, "'") &gt; 0
    If pos &lt;&gt; 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(" &amp; Range("H12").Value &amp; "," &amp; Cells(RowCount, 1) _
      &amp; "," &amp; Cells(RowCount, 6) &amp; "," &amp; Cells(RowCount, 7) &amp; ",'" &amp; _
      desc &amp; "')"
      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(" &amp; Range("H12").Value &amp; "," &amp; Range("H30").Value &amp; "," &amp; Excel.WorksheetFunction.Sum(Report.Range("F16:F29")) &amp; ",'" &amp; Range("A34").Value &amp; _
  "','" &amp; Range("F7").Value &amp; "','" &amp; Range("C12").Value &amp; "','" &amp; Range("A38").Value &amp; ",0," &amp; Code &amp; ")"
  '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 &amp; "@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:" &amp; Email &amp; "?subject=PO#" &amp; EmailPO &amp; "&amp;Body=Approval_Code:" &amp; 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
  </code></pre>
  
  <p>I do apologise for the immense amount of code, and if anyone knows a better way, please tell me. SMSS Is screaming at me. :(</p>