Posts by ravi_shankar

Sub MailMerge()
    
    Dim wd As Object
    Dim wdocSource As Object
    Dim wdInputName As String
    Dim strWorkbookName As String
    
    
    ' Prompt user to select the Word file to use for the mail merge
    wdInputName = Application.GetOpenFilename("Word Documents (*.docx),*.docx", , "Select Word File for Mail Merge")

    If wdInputName <> "" Then
        On Error Resume Next
        Set wd = GetObject(wdInputName, "Word.Application")
        If wd Is Nothing Then
            Set wd = CreateObject("Word.Application")
        End If
        On Error GoTo 0

        Set wdocSource = wd.Documents.Open(wdInputName)
        
        strWorkbookName = ThisWorkbook.Path & "\" & ThisWorkbook.Name

        wdocSource.MailMerge.MainDocumentType = wdFormLetters

        wdocSource.MailMerge.OpenDataSource _
                Name:=strWorkbookName, _
                AddToRecentFiles:=False, _
                Revert:=False, _
                Format:=wdOpenFormatAuto, _
                Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _
                SQLStatement:="SELECT * FROM `Database$`"

        With wdocSource.MailMerge
            .Destination = wdSendToNewDocument
            .SuppressBlankLines = True
            With .DataSource
                .FirstRecord = wdDefaultLastRecord
                .LastRecord = wdDefaultLastRecord
            End With
            .Execute Pause:=False
        End With

        wd.Visible = True
        wd.Quit
        wdocSource.Close SaveChanges:=False

        Set wdocSource = Nothing
        Set wd = Nothing
        
    Else
        ' User cancelled file selection, do nothing
        Exit Sub
    End If

End Sub

Sub Submit()
Dim sh As Worksheet
Dim irow As Long
    Set sh = ThisWorkbook.Sheets((lstIndex.List(lstIndex.ListIndex) + 2))
    Application.EnableEvents = False
    sh.Activate
    irow = Cells(Rows.Count, "E").End(xlUp).Row + 1
    With sh
.Cells(irow, 5) = frmMain.txtGSR.value
.Cells(irow, 7) = frmMain.txtDate.value
    End With
    Application.EnableEvents = True
End Sub

Sub MailMergeARDS()

    Dim wd As Object
    Dim wdocSource As Object
    Dim wdInputName As String
    Dim strWorkbookName As String
    wdInputName = ThisWorkbook.Path & "\A00F200eAuditReferenceDataSheet.docx"
    
    On Error Resume Next
    Set wd = GetObject(wdInputName, "Word.Application")
    Set wd = GetObject(, "Word.Application")
    If wd Is Nothing Then
        Set wd = CreateObject("Word.Application")
    End If
    On Error GoTo 0

    Set wdocSource = wd.Documents.Open("E:\Multisite\A00F200eAuditReferenceDataSheet.docx")
    strWorkbookName = ThisWorkbook.Path & "\" & ThisWorkbook.Name

    wdocSource.MailMerge.MainDocumentType = wdFormLetters

    wdocSource.MailMerge.OpenDataSource _
            Name:=strWorkbookName, _
            AddToRecentFiles:=False, _
            Revert:=False, _
            Format:=wdOpenFormatAuto, _
            Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _
            SQLStatement:="SELECT * FROM `Database$`"

    With wdocSource.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultLastRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
    End With

    wd.Visible = True
    wd.Quit
    wdocSource.Close SaveChanges:=False

    Set wdocSource = Nothing
    Set wd = Nothing
End Sub