Hello!
Thank you in advance for any help as can be provided.
I got help on this macro to add the folder picker feature and it works brilliantly! I am adjusting the macro for a different worksheet structure and to include two additional actions. Searching online, I tried to add the component to create a new folder and save the file to said folder but it is not working. I suspect I have the new piece incorrectly placed and maybe missing a command. But, as someone who knows very little VBA, I just don't know how to fix this. Thank you.
Image shows sample spreadsheet and data.
The Macro includes some comments so I could remember what each part does and make notes where I think I am having issues.
As is, the macro is not creating the new folder but it is creating the XML document in the parent folder selected using the dialogue box (It's as if I didn't even add the part about creating a new folder).
For each row, I was hoping I would be able to:
1. Select the parent folder (works)
2. Create a new folder using the value in Column D (FolderName) for the new folder name (not working)
3. Create the text/XML document (works)
4. Save document to the corresponding new folder in the same row (not working).
Meaning, the new file, "Folder 1.opex" would be saved to "Folder 1" in the parent folder selected. This would go down the rows until the last used row.
Sub ExportOPEXFolderAO()
Dim FldrPicker As FileDialog
Dim myFolder As String
Dim NewFolder As String
'Have User Select Folder to Save to with Dialog Box
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then Exit Sub 'Check if user clicked cancel button
myFolder = .SelectedItems(1) & "\"
End With
'Create new folder in selected directory using column d for folder name
'Not creating new folder but not impacting creating the XML file either
With ActiveWorkbook.Worksheets(2)
lLastUsedRow = .UsedRange.Rows.Count
On Error Resume Next
For lLastUsed = 2 To lLastUsedRow
NewFolder = Cells(1, d).Value
MkDir myFolder & NewFolder
Next
End With
'Template for XML file
sTemplateXML = _
"<?xml version='1.0' encoding='UTF-8'?>" + vbNewLine + _
"<opex:OPEXMetadata xmlns
pex='Domain Registered at Safenames'>" + vbNewLine + _
" <opex:Properties>" + vbNewLine + _
" <opex:Title></opex:Title>" + vbNewLine + _
" <opex:SecurityDescriptor></opex:SecurityDescriptor>" + vbNewLine + _
" <opex:Identifiers>" + vbNewLine + _
" <opex:Identifier type='code'></opex:Identifier>" + vbNewLine + _
" </opex:Identifiers>" + vbNewLine + _
" </opex:Properties>" + vbNewLine + _
" <opex:DescriptiveMetadata>" + vbNewLine + _
" <LegacyXIP xmlns='http://preservica.com/LegacyXIP'>" + vbNewLine + _
" <Virtual>false</Virtual>" + vbNewLine + _
" </LegacyXIP>" + vbNewLine + _
" </opex:DescriptiveMetadata>" + vbNewLine + _
"</opex:OPEXMetadata>" + vbNewLine
'Creates text file
Set doc = CreateObject("MSXML2.DOMDocument")
doc.async = False
doc.validateOnParse = False
doc.resolveExternals = False
With ActiveWorkbook.Worksheets(2)
lLastRow = .UsedRange.Rows.Count
For lRow = 2 To lLastRow
sFile = .Cells(lRow, 1).Value
stitle = .Cells(lRow, 2).Value
ssecuritydescriptor = Format(.Cells(lRow, 3).Value)
sidentifier = Format(.Cells(lRow, 2).Value)
doc.LoadXML sTemplateXML
doc.getElementsByTagName("opex:Title")(0).appendChild doc.createTextNode(stitle)
doc.getElementsByTagName("opex:SecurityDescriptor")(0).appendChild doc.createTextNode(ssecuritydescriptor)
doc.getElementsByTagName("opex:Identifier")(0).appendChild doc.createTextNode(sidentifier)
'Saves to new folder from same row
'New folder is not created but files are still being saved to myFolder
doc.Save myFolder & NewFolder & sFile
Next
End With
MsgBox "Successfully migrated Excel data into XML files!", vbInformation
End Sub
**Just as a note, I intend to save this to PERSONAL.XLSB and add a button to my toolbar so I can run it in any workbook. I did this for another Macro that runs on the first worksheet of a workbook whereas this one is set to run on the second worksheet. I could not set either to simply run on the active worksheet I was working in, couldn't get it to work. While this option would just make it easier (I think), so long as each of my workbooks are structured the same, I anticipate the sheets being in the same order when I need to call the macros.
Thank you, again.
Cheers!
Thank you in advance for any help as can be provided.
I got help on this macro to add the folder picker feature and it works brilliantly! I am adjusting the macro for a different worksheet structure and to include two additional actions. Searching online, I tried to add the component to create a new folder and save the file to said folder but it is not working. I suspect I have the new piece incorrectly placed and maybe missing a command. But, as someone who knows very little VBA, I just don't know how to fix this. Thank you.
Image shows sample spreadsheet and data.
The Macro includes some comments so I could remember what each part does and make notes where I think I am having issues.
As is, the macro is not creating the new folder but it is creating the XML document in the parent folder selected using the dialogue box (It's as if I didn't even add the part about creating a new folder).
For each row, I was hoping I would be able to:
1. Select the parent folder (works)
2. Create a new folder using the value in Column D (FolderName) for the new folder name (not working)
3. Create the text/XML document (works)
4. Save document to the corresponding new folder in the same row (not working).
Meaning, the new file, "Folder 1.opex" would be saved to "Folder 1" in the parent folder selected. This would go down the rows until the last used row.
Sub ExportOPEXFolderAO()
Dim FldrPicker As FileDialog
Dim myFolder As String
Dim NewFolder As String
'Have User Select Folder to Save to with Dialog Box
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then Exit Sub 'Check if user clicked cancel button
myFolder = .SelectedItems(1) & "\"
End With
'Create new folder in selected directory using column d for folder name
'Not creating new folder but not impacting creating the XML file either
With ActiveWorkbook.Worksheets(2)
lLastUsedRow = .UsedRange.Rows.Count
On Error Resume Next
For lLastUsed = 2 To lLastUsedRow
NewFolder = Cells(1, d).Value
MkDir myFolder & NewFolder
Next
End With
'Template for XML file
sTemplateXML = _
"<?xml version='1.0' encoding='UTF-8'?>" + vbNewLine + _
"<opex:OPEXMetadata xmlns
pex='Domain Registered at Safenames'>" + vbNewLine + _" <opex:Properties>" + vbNewLine + _
" <opex:Title></opex:Title>" + vbNewLine + _
" <opex:SecurityDescriptor></opex:SecurityDescriptor>" + vbNewLine + _
" <opex:Identifiers>" + vbNewLine + _
" <opex:Identifier type='code'></opex:Identifier>" + vbNewLine + _
" </opex:Identifiers>" + vbNewLine + _
" </opex:Properties>" + vbNewLine + _
" <opex:DescriptiveMetadata>" + vbNewLine + _
" <LegacyXIP xmlns='http://preservica.com/LegacyXIP'>" + vbNewLine + _
" <Virtual>false</Virtual>" + vbNewLine + _
" </LegacyXIP>" + vbNewLine + _
" </opex:DescriptiveMetadata>" + vbNewLine + _
"</opex:OPEXMetadata>" + vbNewLine
'Creates text file
Set doc = CreateObject("MSXML2.DOMDocument")
doc.async = False
doc.validateOnParse = False
doc.resolveExternals = False
With ActiveWorkbook.Worksheets(2)
lLastRow = .UsedRange.Rows.Count
For lRow = 2 To lLastRow
sFile = .Cells(lRow, 1).Value
stitle = .Cells(lRow, 2).Value
ssecuritydescriptor = Format(.Cells(lRow, 3).Value)
sidentifier = Format(.Cells(lRow, 2).Value)
doc.LoadXML sTemplateXML
doc.getElementsByTagName("opex:Title")(0).appendChild doc.createTextNode(stitle)
doc.getElementsByTagName("opex:SecurityDescriptor")(0).appendChild doc.createTextNode(ssecuritydescriptor)
doc.getElementsByTagName("opex:Identifier")(0).appendChild doc.createTextNode(sidentifier)
'Saves to new folder from same row
'New folder is not created but files are still being saved to myFolder
doc.Save myFolder & NewFolder & sFile
Next
End With
MsgBox "Successfully migrated Excel data into XML files!", vbInformation
End Sub
**Just as a note, I intend to save this to PERSONAL.XLSB and add a button to my toolbar so I can run it in any workbook. I did this for another Macro that runs on the first worksheet of a workbook whereas this one is set to run on the second worksheet. I could not set either to simply run on the active worksheet I was working in, couldn't get it to work. While this option would just make it easier (I think), so long as each of my workbooks are structured the same, I anticipate the sheets being in the same order when I need to call the macros.
Thank you, again.
Cheers!
