Hi Folks ...
When I attempt to make a directory in VBA using MkDir = My_path I have a problem in that the folder attribute of the last folder created is set to read-only. It seems even if one removes this manually and applies it reappears.
So far - I have tried adding SetAttr Root_Path, vbNormal - but that doesn't make any difference.
Looking forward for further advice ....
This is my code:
Sub Test()
Dim MyPath As String
Dim FileName As String
Dim lRow As Integer
lRow = Range("D" & Rows.Count).End(xlUp).Row
Dim RowC As Integer
RowC = 2
Dim File_Num As Long
Dim Root_Path As String
Root_Path = "c:\html_out3"
On Error Resume Next
If Trim(Dir(Root_Path, vbDirectory)) = "" Then
MkDir Root_Path
SetAttr Root_Path, vbNormal
Else
Kill Root_Path & "*.html"
End If
On Error GoTo 0
File_Num = FreeFile
With ActiveSheet
Do Until RowC > Range("D" & Rows.Count).End(xlUp).Row
My_Path = Root_Path
For Each Cell In Range("A" & RowC & ":C" & RowC)
If Cell.Value <> "" Then
My_Path = My_Path & (Cell.Value) & ""
End If
If Dir(My_Path, vbDirectory) = "" Then
MkDir My_Path
SetAttr My_Path, vbNormal
End If
Next Cell
FileName = (Cells(RowC, "D").Value)
'MsgBox FileName
Open My_Path & FileName & ".html" For Output As #File_Num
Print #File_Num , Cells(RowC, "E").Value
Close #File_Num
RowC = RowC + 1
Loop
End With
MsgBox RowC - 2 & " files created and saved to : " & Root_Path
End Sub
When I attempt to make a directory in VBA using MkDir = My_path I have a problem in that the folder attribute of the last folder created is set to read-only. It seems even if one removes this manually and applies it reappears.
So far - I have tried adding SetAttr Root_Path, vbNormal - but that doesn't make any difference.
Looking forward for further advice ....
This is my code:
Sub Test()
Dim MyPath As String
Dim FileName As String
Dim lRow As Integer
lRow = Range("D" & Rows.Count).End(xlUp).Row
Dim RowC As Integer
RowC = 2
Dim File_Num As Long
Dim Root_Path As String
Root_Path = "c:\html_out3"
On Error Resume Next
If Trim(Dir(Root_Path, vbDirectory)) = "" Then
MkDir Root_Path
SetAttr Root_Path, vbNormal
Else
Kill Root_Path & "*.html"
End If
On Error GoTo 0
File_Num = FreeFile
With ActiveSheet
Do Until RowC > Range("D" & Rows.Count).End(xlUp).Row
My_Path = Root_Path
For Each Cell In Range("A" & RowC & ":C" & RowC)
If Cell.Value <> "" Then
My_Path = My_Path & (Cell.Value) & ""
End If
If Dir(My_Path, vbDirectory) = "" Then
MkDir My_Path
SetAttr My_Path, vbNormal
End If
Next Cell
FileName = (Cells(RowC, "D").Value)
'MsgBox FileName
Open My_Path & FileName & ".html" For Output As #File_Num
Print #File_Num , Cells(RowC, "E").Value
Close #File_Num
RowC = RowC + 1
Loop
End With
MsgBox RowC - 2 & " files created and saved to : " & Root_Path
End Sub