Macro not saving exported files to where it should

shand

New Member
Joined
Feb 15, 2024
Messages
6
Office Version
  1. 365
Platform
  1. Windows
Hi,
This is my very first post. I am adding a lot of backstory to this because I am truly at a lost and have tried to find a solution for a few years. I am using Office 365 which is, of course, utilizing OneDrive. I also have SharePoint Libraries where I may have my workbooks saved. Those I access most, I sync so I have access to them in File Explorer.

I am not a coder, but I have borrowed code snippets and functions over the many years including .bat files. Many years ago I found a VBA code for exactly what I needed in Excel and it works brilliantly (I have seen the code posted in many forums so I cannot credit any one person). The Macro exports rows of data from Excel to separate XML files in a schema structure with headers and all. It continues to work and I even tweaked it when I had to add a new namespace. Just the other day, I followed a tutorial for saving the macro to PERSONAL.XLSB so I can run it in any workbook, any time and created a personalized tab in the ribbon and added a button to run the macro. Totally awesome. However, this is the part where I am stuck. The VBA code is supposed to save the XML files to the same location as the workbook I am working in. A while back, it stopped doing that and saves the files to my Documents folder. I lived with this but I as my work has exploded, I really need it to work as it should.

I attempted to add a folder selection snippet and it works, sort of. It opens the dialog box, I can select a folder, it confirms the folder I want, but then saves the new files as a sibling to the folder I selected. I have also attempted to use thisWorkbook.path (which saves the files to XLSTART) as well as activeWorkbook.path (which did nothing), no dice. I have search for other options but do not know how to either incorporate what I find into my specific scenario or they are complex and I am not sure it is what I need or want. The file name is created via the spreadsheet including the extension, so I do not need that as a component of the code.

This is the original code I found years ago. It does exactly what I need except the save location issue. My understanding is that it should save to the same location as the workbook I am running it in.
VBA Code:
Sub ExportByRow()
sTemplateXML = _
        "<?xml version='1.0' encoding='UTF-8'?>" + vbNewLine + _
        "<oai_dc:dc xsi:schemaLocation='http://www.openarchives.org/OAI/2.0/oai_dc.xsd' xmlns:dc='http://purl.org/dc/elements/1.1/' xmlns:oai_dc='http://www.openarchives.org/OAI/2.0/oai_dc/' xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance'>" + vbNewLine + _
        "<!-- dublin core -->" + vbNewLine + _
        "   <dc:title></dc:title>" + vbNewLine + _
        "   <dc:creator></dc:creator>" + vbNewLine + _
        "   <dc:subject></dc:subject>" + vbNewLine + _
        "   <dc:description></dc:description>" + vbNewLine + _
        "   <dc:publisher></dc:publisher>" + vbNewLine + _
        "   <dc:contributor></dc:contributor>" + vbNewLine + _
        "   <dc:date></dc:date>" + vbNewLine + _
        "   <dc:type></dc:type>" + vbNewLine + _
        "   <dc:format></dc:format>" + vbNewLine + _
        "   <dc:identifier></dc:identifier>" + vbNewLine + _
        "   <dc:source></dc:source>" + vbNewLine + _
        "   <dc:language></dc:language>" + vbNewLine + _
        "   <dc:relation></dc:relation>" + vbNewLine + _
        "   <dc:coverage></dc:coverage>" + vbNewLine + _
        "   <dc:rights></dc:rights>" + vbNewLine + _
        "</oai_dc:dc>" + vbNewLine

Set doc = CreateObject("MSXML2.DOMDocument")
doc.async = False
doc.validateOnParse = False
doc.resolveExternals = False

With ActiveWorkbook.Worksheets(1)
  lLastRow = .UsedRange.Rows.Count

  For lRow = 2 To lLastRow
   sFile = .Cells(lRow, 1).Value
   stitle = .Cells(lRow, 2).Value
   screator = Format(.Cells(lRow, 3).Value)
   ssubject = Format(.Cells(lRow, 4).Value)
   sdescription = .Cells(lRow, 5).Value
   spublisher = .Cells(lRow, 6).Value
   scontributor = .Cells(lRow, 7).Value
   sdate = .Cells(lRow, 8).Value
   stype = .Cells(lRow, 9).Value
   sformat = .Cells(lRow, 10).Value
   sidentifier = .Cells(lRow, 11).Value
   ssource = .Cells(lRow, 12).Value
   slanguage = .Cells(lRow, 13).Value
   srelation = .Cells(lRow, 14).Value
   scoverage = .Cells(lRow, 15).Value
   srights = .Cells(lRow, 16).Value
   doc.LoadXML sTemplateXML
   doc.getElementsByTagName("dc:title")(0).appendChild doc.createTextNode(stitle)
   doc.getElementsByTagName("dc:creator")(0).appendChild doc.createTextNode(screator)
   doc.getElementsByTagName("dc:subject")(0).appendChild doc.createTextNode(ssubject)
   doc.getElementsByTagName("dc:description")(0).appendChild doc.createTextNode(sdescription)
   doc.getElementsByTagName("dc:publisher")(0).appendChild doc.createTextNode(spublisher)
   doc.getElementsByTagName("dc:contributor")(0).appendChild doc.createTextNode(scontributor)
   doc.getElementsByTagName("dc:date")(0).appendChild doc.createTextNode(sdate)
   doc.getElementsByTagName("dc:type")(0).appendChild doc.createTextNode(stype)
   doc.getElementsByTagName("dc:format")(0).appendChild doc.createTextNode(sformat)
   doc.getElementsByTagName("dc:identifier")(0).appendChild doc.createTextNode(sidentifier)
   doc.getElementsByTagName("dc:source")(0).appendChild doc.createTextNode(ssource)
   doc.getElementsByTagName("dc:language")(0).appendChild doc.createTextNode(slanguage)
   doc.getElementsByTagName("dc:relation")(0).appendChild doc.createTextNode(srelation)
   doc.getElementsByTagName("dc:coverage")(0).appendChild doc.createTextNode(scoverage)
   doc.getElementsByTagName("dc:rights")(0).appendChild doc.createTextNode(srights)
   doc.Save sFile
  Next

End With
End Sub


This is the folder selection snippet I found and tried, but is saving the files in the parent folder of the folder I select. I added it after Sub ExportByRow() and before sTemplateXML = _
VBA Code:
Dim FldrPicker As FileDialog
Dim myFolder 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

Thank you in advance for taking the time to read this and for any guidance you can provide.
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
This is the original code I found years ago. It does exactly what I need except the save location issue. My understanding is that it should save to the same location as the workbook I am running it in.

This line creates/saves the XML file for each row:
VBA Code:
   doc.Save sFile

The sFile variable is read from the column A cell using this line:
VBA Code:
  sFile = .Cells(lRow, 1).Value

If the column A cell contains only the XML file name, without any folder path, e.g. "My data.xml" then the above Save would save the .xml file to the default location, which is usually the Documents or My Documents folder. You would need to include the folder path in the column A cell to save it in a specific location, e.g. "C:\path\to\folder\My data.xml", or specify the folder path on the above Save line:

VBA Code:
   doc.Save ActiveWorkbook.Path & "\" & sFile

Or, to use the folder selected by the user:

VBA Code:
   doc.Save myFolder & sFile
 
Upvote 1
Solution
doc.Save ActiveWorkbook.Path & "\" & sFile
I tried this previously and it wouldn't work, I even tried thisWorkbook.path...

However, this worked. I cannot thank you enough!
VBA Code:
doc.Save myFolder & sFile

This is now my full code with your fix.

VBA Code:
Sub ExportRowsToSeparateXML()

Dim FldrPicker As FileDialog
Dim myFolder 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

sTemplateXML = _
        "<?xml version='1.0' encoding='UTF-8'?>" + vbNewLine + _
        "<opex:OPEXMetadata xmlns:opex='http://www.openpreservationexchange.org/opex/v1.0'>" + vbNewLine + _
        "<opex:DescriptiveMetadata>" + vbNewLine + _
        "<oai_dc:dc xsi:schemaLocation='http://www.openarchives.org/OAI/2.0/oai_dc.xsd' xmlns:dc='http://purl.org/dc/elements/1.1/' xmlns:oai_dc='http://www.openarchives.org/OAI/2.0/oai_dc/' xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance'>" + vbNewLine + _
        "<!-- dublin core -->" + vbNewLine + _
        "   <dc:title></dc:title>" + vbNewLine + _
        "   <dc:creator></dc:creator>" + vbNewLine + _
        "   <dc:subject></dc:subject>" + vbNewLine + _
        "   <dc:description></dc:description>" + vbNewLine + _
        "   <dc:publisher></dc:publisher>" + vbNewLine + _
        "   <dc:contributor></dc:contributor>" + vbNewLine + _
        "   <dc:date></dc:date>" + vbNewLine + _
        "   <dc:type></dc:type>" + vbNewLine + _
        "   <dc:format></dc:format>" + vbNewLine + _
        "   <dc:identifier></dc:identifier>" + vbNewLine + _
        "   <dc:source></dc:source>" + vbNewLine + _
        "   <dc:language></dc:language>" + vbNewLine + _
        "   <dc:relation></dc:relation>" + vbNewLine + _
        "   <dc:coverage></dc:coverage>" + vbNewLine + _
        "   <dc:rights></dc:rights>" + vbNewLine + _
        "</oai_dc:dc>" + vbNewLine + _
        "</opex:DescriptiveMetadata>" + vbNewLine + _
        "</opex:OPEXMetadata>" + vbNewLine
 
Set doc = CreateObject("MSXML2.DOMDocument")
doc.async = False
doc.validateOnParse = False
doc.resolveExternals = False
 
With ActiveWorkbook.Worksheets(1)
  lLastRow = .UsedRange.Rows.Count
 
  For lRow = 2 To lLastRow
   sFile = .Cells(lRow, 1).Value
   stitle = .Cells(lRow, 2).Value
   screator = Format(.Cells(lRow, 3).Value)
   ssubject = Format(.Cells(lRow, 4).Value)
   sdescription = .Cells(lRow, 5).Value
   spublisher = .Cells(lRow, 6).Value
   scontributor = .Cells(lRow, 7).Value
   sdate = .Cells(lRow, 8).Value
   stype = .Cells(lRow, 9).Value
   sformat = .Cells(lRow, 10).Value
   sidentifier = .Cells(lRow, 11).Value
   ssource = .Cells(lRow, 12).Value
   slanguage = .Cells(lRow, 13).Value
   srelation = .Cells(lRow, 14).Value
   scoverage = .Cells(lRow, 15).Value
   srights = .Cells(lRow, 16).Value
   doc.LoadXML sTemplateXML
   doc.getElementsByTagName("dc:title")(0).appendChild doc.createTextNode(stitle)
   doc.getElementsByTagName("dc:creator")(0).appendChild doc.createTextNode(screator)
   doc.getElementsByTagName("dc:subject")(0).appendChild doc.createTextNode(ssubject)
   doc.getElementsByTagName("dc:description")(0).appendChild doc.createTextNode(sdescription)
   doc.getElementsByTagName("dc:publisher")(0).appendChild doc.createTextNode(spublisher)
   doc.getElementsByTagName("dc:contributor")(0).appendChild doc.createTextNode(scontributor)
   doc.getElementsByTagName("dc:date")(0).appendChild doc.createTextNode(sdate)
   doc.getElementsByTagName("dc:type")(0).appendChild doc.createTextNode(stype)
   doc.getElementsByTagName("dc:format")(0).appendChild doc.createTextNode(sformat)
   doc.getElementsByTagName("dc:identifier")(0).appendChild doc.createTextNode(sidentifier)
   doc.getElementsByTagName("dc:source")(0).appendChild doc.createTextNode(ssource)
   doc.getElementsByTagName("dc:language")(0).appendChild doc.createTextNode(slanguage)
   doc.getElementsByTagName("dc:relation")(0).appendChild doc.createTextNode(srelation)
   doc.getElementsByTagName("dc:coverage")(0).appendChild doc.createTextNode(scoverage)
   doc.getElementsByTagName("dc:rights")(0).appendChild doc.createTextNode(srights)
   doc.Save myFolder & sFile
   
  Next
 
End With
End Sub
 
Upvote 0

Forum statistics

Threads
1,215,076
Messages
6,122,987
Members
449,093
Latest member
Mr Hughes

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top