GenerateWordDocsForReports.bas

Sub GenerateWordDocsForReports()
    Dim wsConfig As Worksheet, wsReports As Worksheet
    Dim configList As ListObject, reportsList As ListObject
    Dim docFolder As String, reportName As String, cleanName As String
    Dim filePath As String, i As Long
    Dim wdApp As Object, wdDoc As Object
    
    ' Set references to tables
    Set wsConfig = ThisWorkbook.Sheets("Doc Gen")
    Set wsReports = ThisWorkbook.Sheets("Doc Gen")
    Set configList = wsConfig.ListObjects("Config")
    Set reportsList = wsReports.ListObjects("Reports")
    
    ' Get Doc Folder from Config table
    docFolder = ""
    Dim r As ListRow
    For Each r In configList.ListRows
        If LCase(r.Range(1, 1).Value) = "doc folder" Then
            docFolder = r.Range(1, 2).Value
            Exit For
        End If
    Next r
    
    If docFolder = "" Then
        MsgBox "Doc Folder not found in Config table.", vbCritical
        Exit Sub
    End If
    
    ' Ensure folder ends with backslash
    If Right(docFolder, 1) <> "\" Then docFolder = docFolder & "\"
    
    ' Create Word application object
    On Error Resume Next
    Set wdApp = GetObject(Class:="Word.Application")
    If wdApp Is Nothing Then
        Set wdApp = CreateObject("Word.Application")
    End If
    On Error GoTo 0
    
    wdApp.Visible = False
    
    ' Loop through Reports table
    For i = 1 To reportsList.ListRows.Count
        reportName = reportsList.DataBodyRange(i, 1).Value
        
        ' Clean report name for Windows filename
        cleanName = reportName
        cleanName = Replace(cleanName, "\", "_")
        cleanName = Replace(cleanName, "/", "_")
        cleanName = Replace(cleanName, ":", "_")
        cleanName = Replace(cleanName, "*", "_")
        cleanName = Replace(cleanName, "?", "_")
        cleanName = Replace(cleanName, """", "_")
        cleanName = Replace(cleanName, "<", "_")
        cleanName = Replace(cleanName, ">", "_")
        cleanName = Replace(cleanName, "|", "_")
        
        filePath = docFolder & cleanName & ".docx"
        
        ' Check if file exists
        If Dir(filePath) = "" Then
            ' Create new Word document
            Set wdDoc = wdApp.Documents.Add
            wdDoc.SaveAs2 filePath
            wdDoc.Close
        End If
        
        ' Update Doc Link column with hyperlink
        reportsList.DataBodyRange(i, 2).Hyperlinks.Delete
        reportsList.DataBodyRange(i, 2).Hyperlinks.Add _
            Anchor:=reportsList.DataBodyRange(i, 2), _
            Address:=filePath, _
            TextToDisplay:="Open Document"
    Next i
    
    wdApp.Quit
    Set wdApp = Nothing
    
    MsgBox "Documents generated successfully!", vbInformation
End Sub