VBA code to create a word document, link it to a cell and save the document using the cell value

[cmannp]

I am trying to create a Macros that will create a word document(for notes) and link it to a cell in the row and same the document using the value in the cell.
My code is able to do just that for one cell but I want it to be able to run through the different cells in the row and save each document created with the value of each cell. my code gives me an erro saying document exist if I try to run it on other cells. PLEASE help.


Sub Macro1()
'
' Macro1 Macro
'

'


Dim NumRows As String
SaveName = Range("A3", Range("A3")).End(xlDown).Value
Range("A3").Activate

For Each A In Range("A3", Range("A3")).End(xlDown)

ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
"\\rqhdata4\Quality Impr\PERSONAL FILES\Chinedu\Note\"
ActiveSheet.Hyperlinks(ActiveSheet.Hyperlinks.Count).CreateNewDocument _
Filename:="\\rqhdata4\Quality Impr\PERSONAL FILES\Chinedu\Note\ " & SaveName & ".docx", _
EditNow:=True, Overwrite:=False
Next A

End Sub

 

[Skyybot]

Sub Macro1()
'
' Macro1 Macro
'

'


Dim NumRows As String

Range("A3").Activate

For Each A In Range("A3", Range("A3")).End(xlDown)
SaveName = A.Value
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
"\\rqhdata4\Quality Impr\PERSONAL FILES\Chinedu\Note\"
ActiveSheet.Hyperlinks(ActiveSheet.Hyperlinks.Count).CreateNewDocument _
Filename:="\\rqhdata4\Quality Impr\PERSONAL FILES\Chinedu\Note\ " & SaveName & ".docx", _
EditNow:=True, Overwrite:=False
Next A

End Sub

 

[cmannp]

Sub Macro1()
'
' Macro1 Macro
'

'


Dim NumRows As String

Range("A3").Activate

For Each A In Range("A3", Range("A3")).End(xlDown)
SaveName = A.Value
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
"\\rqhdata4\Quality Impr\PERSONAL FILES\Chinedu\Note\"
ActiveSheet.Hyperlinks(ActiveSheet.Hyperlinks.Count).CreateNewDocument _
Filename:="\\rqhdata4\Quality Impr\PERSONAL FILES\Chinedu\Note\ " & SaveName & ".docx", _
EditNow:=True, Overwrite:=False
Next A

End Sub

I still get error saying the file exist when I go to the next cell. the code is not picking up the value in the next cell.

 

[cmannp]

Sub CreateWordDocumentAndLink()
Dim wordApp As Object
Dim doc As Object
Dim ws As Worksheet
Dim path As String
Dim cellValue As String
Dim i As Integer

Set wordApp = CreateObject("Word.Application")
wordApp.Visible = True

Set ws = ThisWorkbook.Sheets("Sheet1") ' Replace "Sheet1" with your actual sheet name

For i = 1 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
cellValue = ws.Cells(i, 1).Value
path = "\\rqhdata4\Quality Impr\PERSONAL FILES\Chinedu\Note\" & cellValue & ".docx"

If Dir(path) = "" Then
Set doc = wordApp.Documents.Add
doc.SaveAs2 path
ws.Hyperlinks.Add Anchor:=ws.Cells(i, 1), Address:=path
doc.Close
End If
Next i

wordApp.Quit
Set wordApp = Nothing
End Sub
```

This worked