Export XML Map with VBA

mrlionsss

New Member
Joined
Nov 11, 2020
Messages
8
Office Version
  1. 2007
Platform
  1. Windows
I have an XML Map that is mapped to a Sheet in Excel.

I always exported it through Developer - Export, wrote the filename, clicked through the folders and exported it.

I'm trying to make my life a bit easier and wanted to create a button on the Sheet, that would trigger the Export dialog window with a suggested file name and file path from the cell A24, since the name of the folders in my documents are always the same as the value in A24.

I came very close to making this happen by writing this code:

VBA Code:
Public Sub ExportToXML()

    Dim strFileName As String
    Dim FilePath As String
    Dim objMapToExport As Variant

Filepath = "C:\Users\admin\Desktop\Documents\" & Range("A24") & "\" & Range("A24") & ".xml"

strFileName = Application.GetSaveAsFilename(InitialFileName:=Filepath, FileFilter:="XML Files (*.xml), *.xml", Title:="Save FileAs...")
        
        If strFileName <> False Then
            ActiveWorkbook.SaveAsXMLData Filepath, objMapToExport
            MsgBox "Saved " & Filepath
        Else
            MsgBox "User cancelled - not saved"
        End If

End Sub

This brings up the Export dialog windows with the suggested file name and file path correctly and when I hit Save, it actually saves.

The problem is when I decide to Export the XML to a different folder than the one suggested, it obviously saves to the suggested file path anyway, because of
Code:
ActiveWorkbook.SaveAsXMLData Filepath, objMapToExport

Now i know there is a lot of this on the internet and i've read through most of it and tried bunch of different stuff, but always seem to end up in a dead end.

How and what do i have to change/add to have the suggested file name and path, but if the folder does not exist or the user decides to save it elsewhere, it actually does.

Any help is appreciated!
 

Some videos you may like

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

nemmi69

Active Member
Joined
Mar 15, 2012
Messages
482
Office Version
  1. 365
  2. 2016
  3. 2013
Platform
  1. Windows
This idea any help?

VBA Code:
Option Explicit

Dim TmpSaveName As String
Dim FileSaveName As String
Dim GetFName As String
Dim MsgRet As String
Dim OK2Save As Boolean


Sub GetSaveName()
'=========================================================
'Get filename to save as
'=========================================================
TmpSaveName = "C:\Users\admin\Desktop\Documents\" & Range("A24").Value & "\" & Range("A24") & ".xml"

FileSaveName = ""
OK2Save = False

Do While FileSaveName = "" Or OK2Save = False
    GetFName = Application.GetSaveAsFilename( _
        InitialFileName:=TmpSaveName, _
        fileFilter:="XML Files (*.XML), *.XML")
    If GetFName <> "False" Then
        FileSaveName = GetFName
        MsgBox "Save as " & FileSaveName
    Else
       OK2Save = True
       FileSaveName = "NONE"
    End If
Loop

If Trim(FileSaveName) = "NONE" And OK2Save = True Then 'User cancelled
   Exit Sub
Else
    MsgBox "file to save " & FileSaveName
End If
End Sub
 

mrlionsss

New Member
Joined
Nov 11, 2020
Messages
8
Office Version
  1. 2007
Platform
  1. Windows
This idea any help?

VBA Code:
Option Explicit

Dim TmpSaveName As String
Dim FileSaveName As String
Dim GetFName As String
Dim MsgRet As String
Dim OK2Save As Boolean


Sub GetSaveName()
'=========================================================
'Get filename to save as
'=========================================================
TmpSaveName = "C:\Users\admin\Desktop\Documents\" & Range("A24").Value & "\" & Range("A24") & ".xml"

FileSaveName = ""
OK2Save = False

Do While FileSaveName = "" Or OK2Save = False
    GetFName = Application.GetSaveAsFilename( _
        InitialFileName:=TmpSaveName, _
        fileFilter:="XML Files (*.XML), *.XML")
    If GetFName <> "False" Then
        FileSaveName = GetFName
        MsgBox "Save as " & FileSaveName
    Else
       OK2Save = True
       FileSaveName = "NONE"
    End If
Loop

If Trim(FileSaveName) = "NONE" And OK2Save = True Then 'User cancelled
   Exit Sub
Else
    MsgBox "file to save " & FileSaveName
End If
End Sub

This points me to the right folder, but the File name is empty.

When i enter a File name and hit Save, it says "Save as C:\Users\admin\Desktop..." and when i hit ok, it opens the Export window again with an empty File name. This goes on a loop.
 

nemmi69

Active Member
Joined
Mar 15, 2012
Messages
482
Office Version
  1. 365
  2. 2016
  3. 2013
Platform
  1. Windows
Changed it to use your

VBA Code:
Option Explicit

Dim TmpSaveName As String
Dim FileSaveName As String
Dim GetFName As String
Dim MsgRet As String
Dim OK2Save As Boolean


Sub GetSaveName()
'=========================================================
'Get filename to save as GetSaveAsFilename - seems OK
'=========================================================
TmpSaveName = "C:\Users\admin\Desktop\Documents\" & Range("A24").Value & "\" & Range("A24") & ".xml"

FileSaveName = ""
OK2Save = False

Do While FileSaveName = "" Or OK2Save = False
    GetFName = Application.GetSaveAsFilename(InitialFileName:=TmpSaveName, FileFilter:="XML Files (*.xml), *.xml", Title:="Save FileAs...")
    If GetFName <> "False" Then
        FileSaveName = GetFName
        MsgBox "Save as " & FileSaveName
    Else
       OK2Save = True
       FileSaveName = "NONE"
    End If
Loop

If Trim(FileSaveName) = "NONE" And OK2Save = True Then 'User cancelled
   Exit Sub
Else
    MsgBox "file to save " & FileSaveName
End If
End Sub
 

mrlionsss

New Member
Joined
Nov 11, 2020
Messages
8
Office Version
  1. 2007
Platform
  1. Windows

ADVERTISEMENT

Thanks!

Managed to suggest it the right File name and File path, however, when i hit save, it just goes on a loop and keeps opening the Save As/Export window
 

nemmi69

Active Member
Joined
Mar 15, 2012
Messages
482
Office Version
  1. 365
  2. 2016
  3. 2013
Platform
  1. Windows
Teach me to copy out of one of my files
Should be good now


VBA Code:
Option Explicit

Dim TmpSaveName As String
Dim FileSaveName As String
Dim GetFName As String
Dim MsgRet As String

Sub GetSaveName()
'=========================================================
'Get filename to save as GetSaveAsFilename - seems OK
'=========================================================
'TmpSaveName = "C:\Users\admin\Desktop\Documents\" & Range("A24").Value & "\" & Range("A24") & ".xml"
TmpSaveName = "C:\Adump\" & Range("A24").Value & "\" & Range("A24") & ".xml"

FileSaveName = ""

Do While FileSaveName = ""
    GetFName = Application.GetSaveAsFilename(InitialFileName:=TmpSaveName, FileFilter:="XML Files (*.xml), *.xml", Title:="Save FileAs...")
    If GetFName <> "False" Then
        FileSaveName = GetFName
    Else
       FileSaveName = "NONE"
    End If
Loop

If Trim(FileSaveName) = "NONE" Then 'User cancelled
   Exit Sub
Else
    MsgBox "File to save " & FileSaveName
    'Do actual save here
    ActiveWorkbook.SaveAsXMLData FileSaveName, objMapToExport

End If
End Sub
 
Last edited:
Solution

mrlionsss

New Member
Joined
Nov 11, 2020
Messages
8
Office Version
  1. 2007
Platform
  1. Windows
Teach me to copy out of one of my files
Should be good now


VBA Code:
Option Explicit

Dim TmpSaveName As String
Dim FileSaveName As String
Dim GetFName As String
Dim MsgRet As String

Sub GetSaveName()
'=========================================================
'Get filename to save as GetSaveAsFilename - seems OK
'=========================================================
'TmpSaveName = "C:\Users\admin\Desktop\Documents\" & Range("A24").Value & "\" & Range("A24") & ".xml"
TmpSaveName = "C:\Adump\" & Range("A24").Value & "\" & Range("A24") & ".xml"

FileSaveName = ""

Do While FileSaveName = ""
    GetFName = Application.GetSaveAsFilename(InitialFileName:=TmpSaveName, FileFilter:="XML Files (*.xml), *.xml", Title:="Save FileAs...")
    If GetFName <> "False" Then
        FileSaveName = GetFName
    Else
       FileSaveName = "NONE"
    End If
Loop

If Trim(FileSaveName) = "NONE" Then 'User cancelled
   Exit Sub
Else
    MsgBox "File to save " & FileSaveName
    'Do actual save here
    ActiveWorkbook.SaveAsXMLData FileSaveName, objMapToExport

End If
End Sub

Haha, happens to all of us.

This works amazing! You are a genius. Thanks for the help. Much appreciated!
 

Watch MrExcel Video

Forum statistics

Threads
1,118,748
Messages
5,573,995
Members
412,562
Latest member
woodportaj
Top