Export XML Map with VBA

[mrlionsss]

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:

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

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!

 

[nemmi69]

This idea any help?

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]

This idea any help?

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]

Changed it to use your

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]

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]

Teach me to copy out of one of my files
Should be good now

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

 

[mrlionsss]

Teach me to copy out of one of my files
Should be good now

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!

 

[nemmi69]

Your welcome