Private Sub RUN_Click()
Dim DBLoc As String, StrSrc As String, StrFlNm As String
StrSrc = "H:\RDS\ASSESS\2016\Database\2016 OCJP Grants.mdb"
If FundSource.Value = "" Or FedFunds.Value = "" Or Match.Value = "" Or _
  ServiceCharges.Value = "" Or Equipment.Value = "" Or DiscloseInfo.Value = "" Or FFATA.Value = "" Then
  MsgBox ("ERROR: One or more option fields are blank. All fields must be set.")
Else
  With ActiveDocument
    With .CustomDocumentProperties
      .Add Name:="FundSource", Type:=msoPropertyTypeString, Value:=FundSource.Value, LinkToContent:=False
      .Add Name:="FedFunds", Type:=msoPropertyTypeString, Value:=FedFunds.Value, LinkToContent:=False
      .Add Name:="Match", Type:=msoPropertyTypeString, Value:=Match.Value, LinkToContent:=False
      .Add Name:="ServiceCharges", Type:=msoPropertyTypeString, Value:=ServiceCharges.Value, LinkToContent:=False
      .Add Name:="Equipment", Type:=msoPropertyTypeString, Value:=Equipment.Value, LinkToContent:=False
      .Add Name:="DiscloseInfo", Type:=msoPropertyTypeString, Value:=DiscloseInfo.Value, LinkToContent:=False
      .Add Name:="FFATA", Type:=msoPropertyTypeString, Value:=FFATA.Value, LinkToContent:=False
      .Add Name:="DBYear", Type:=msoPropertyTypeString, Value:=DBYear.Value, LinkToContent:=False
    End With
    .Fields.Update
    'MSGBOX will change text/move location/as more parts of the code work.
    MsgBox ("Contract Created. Double Check Margins.")
    'MAIL MERGE CODE HERE
    Application.DisplayAlerts = wdAlertsNone
    With .MailMerge
      .MainDocumentType = wdFormLetters
      .OpenDataSource Name:=StrSrc, ConfirmConversions:=True, ReadOnly:=False, LinkToSource:=False, _
        AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
        WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, Connection:="", _
        SQLStatement:="SELECT AUTH_AGENCY, FUND_SOURC, [2016 EDISON CONTRACT], BEGDATE, ENDDATE, " & _
        "[CFDA #], [VENDOR ID], [2016 SPEED CHART], [ACCOUNT CODE], FED_ID, TITLE_DIR, ADDR1_DIR, " & _
        "ADDR2_DIR, PROJ_DIR, CITY_DIR, PHONE_DIR, ZIP_DIR, EMAIL_DIR, FEDFUNDS16, MTCH_FUNDS16, ", _
        SQLStatement1:="FEDFUNDS17, MTCH_FUNDS17, ALL_FUNDS, MGR_NAM, MGR_GENDER, PHONE_MGR, MGR_EMAIL, " & _
        "[Agency FY End Date], English([ALL_FUNDS]) AS WORD_NUM, SpeedtoFain([2016 Speed Chart]) AS FAIN, " & _
        "SpeedtoDate([2016 Speed Chart]) AS AwardDate, SpeedtoAmount([2016 Speed Chart]) AS AwardAmount, " & _
        "SpeedtoAA([2016 Speed Chart]) AS AwardingAgency, SpeedtoContact([2016 Speed Chart]) AS FederalContact, " & _
        "SpeedtoPhone([2016 Speed Chart]) AS ContactPhone, SpeedtoAwardName([2016 Speed Chart]) AS GrantName, " & _
        "NumofMonths([BegDate],[EndDate]) AS NumMonths, ConvertNumberstoEnglish([NumMonths]) AS MonthWords " & _
        "FROM [2016 OCJP Grants TABLE] WHERE MGR_NAM=""John Doe""", SubType:=wdMergeSubType2000
        For i = 1 To .DataSource.RecordCount
          .Destination = wdSendToNewDocument
          .SuppressBlankLines = True
          With .DataSource
            .FirstRecord = i
            .LastRecord = i
            .ActiveRecord = i
            StrFlNm = .DataFields("AUTH_AGENCY")
          End With
          .Execute Pause:=False
          With ActiveDocument
            .SaveAs FileName:="H:\RDS\ASSESS\Program Files\" & StrFlNm & " Unsigned Contract.doc", _
              FileFormat:=wdFormatDocument, AddToRecentFiles:=False
            .Close SaveChanges:=False
          End With
        Next
        .MainDocumentType = wdNotAMergeDocument
    End With
  End With
    Application.DisplayAlerts = wdAlertsAll
  Unload Me
End If
End Sub