Hi All,
I have this code which creates word document based on the information within a column. It uses the data in the column as the name for the word docs.
I'd like some help to amend the code so that instead of creating word docs it will create a new folder.
Thanks,
Matt
Here's the code:
Private Sub CommandButton1_Click()
Dim i As Integer
Dim wordApp As Object
Dim wordDoc As Object
'Create a Word application object
Set wordApp = CreateObject("Word.Application")
For i = 1 To Me.Range("DocumentList").Rows.Count
'Create the new document
Set wordDoc = wordApp.Documents.Add
'Save the document with the relevant file name
wordDoc.SaveAs ThisWorkbook.Path & "\" & Me.Range("DocumentList").Cells(i).Text & ".doc"
'Setup the hyperlink to the document
With Me.Range("DocumentList").Cells(i).Offset(0, 1)
.Value = "Hyperlink"
.Hyperlinks.Add Me.Range("DocumentList").Cells(i).Offset(0, 1), ThisWorkbook.Path & "\" & Me.Range("DocumentList").Cells(i).Text & ".doc"
End With
Next i
wordApp.Quit
Set wordDoc = Nothing
Set wordApp = Nothing
End Sub
I have this code which creates word document based on the information within a column. It uses the data in the column as the name for the word docs.
I'd like some help to amend the code so that instead of creating word docs it will create a new folder.
Thanks,
Matt
Here's the code:
Private Sub CommandButton1_Click()
Dim i As Integer
Dim wordApp As Object
Dim wordDoc As Object
'Create a Word application object
Set wordApp = CreateObject("Word.Application")
For i = 1 To Me.Range("DocumentList").Rows.Count
'Create the new document
Set wordDoc = wordApp.Documents.Add
'Save the document with the relevant file name
wordDoc.SaveAs ThisWorkbook.Path & "\" & Me.Range("DocumentList").Cells(i).Text & ".doc"
'Setup the hyperlink to the document
With Me.Range("DocumentList").Cells(i).Offset(0, 1)
.Value = "Hyperlink"
.Hyperlinks.Add Me.Range("DocumentList").Cells(i).Offset(0, 1), ThisWorkbook.Path & "\" & Me.Range("DocumentList").Cells(i).Text & ".doc"
End With
Next i
wordApp.Quit
Set wordDoc = Nothing
Set wordApp = Nothing
End Sub