WORD macro: save to desktop

[centavo]

I have a Word macro that saves the doc to a .txt file. It needs to be saved to a folder on the Desktop, as it is one of several data files that the user will subsequently select to be imported into a PDF form. The macro works fine, but how to code the path to Desktop so that it will save to the Desktop of the current user, many of whom will be working on home PCs?

FWIW, here's the macro code; I've substituted <username> for my actual USERPROFILE in the path:

Sub ToText()
'
' ToText Macro

'
Selection.WholeStory
Selection.ConvertToTable Separator:=wdSeparateByParagraphs, NumColumns:=1, _
NumRows:=1, Format:=wdTableFormatNone, ApplyBorders:=True, ApplyShading _
:=True, ApplyFont:=True, ApplyColor:=True, ApplyHeadingRows:=True, _
ApplyLastRow:=False, ApplyFirstColumn:=True, ApplyLastColumn:=False, _
AutoFit:=True, AutoFitBehavior:=wdAutoFitFixed
Selection.Rows.ConvertToText Separator:=wdSeparateByTabs, NestedTables:= _
True
ChangeFileOpenDirectory _
"C:\Documents and Settings\<username>\Desktop\Placement Files\"
ActiveDocument.SaveAs FileName:="child.txt", FileFormat:=wdFormatText, _
LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
False
End Sub


Ideas very welcome!!!!

Donna

[mdmackillop]

Hi Donna,
Welcome to VBAX

Using the Get Desktop Address (http://vbaexpress.com/kb/getarticle.php?kb_id=216) KB item
Sub ToText()
'
' ToText Macro

'
Dim DTAddress As String

Selection.WholeStory
Selection.ConvertToTable Separator:=wdSeparateByParagraphs, NumColumns:=1, _
NumRows:=1, Format:=wdTableFormatNone, ApplyBorders:=True, ApplyShading _
:=True, ApplyFont:=True, ApplyColor:=True, ApplyHeadingRows:=True, _
ApplyLastRow:=False, ApplyFirstColumn:=True, ApplyLastColumn:=False, _
AutoFit:=True, AutoFitBehavior:=wdAutoFitFixed
Selection.Rows.ConvertToText Separator:=wdSeparateByTabs, NestedTables:= _
True

DTAddress = CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator
ActiveDocument.SaveAs DTAddress & "child.txt", FileFormat:=wdFormatText, _
LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
False
End Sub

[centavo]

I've posted a response twice, but haven't seen it yet, so here goes again. Mea culpa if these is a duplicate (or triplicate).

Thanks much for the help. I copied and slightly modified the code you provided and it did the trick!

Donna