Obviously you could adapter it to do what ever type of text file you like (well, and Excel can handle)
VBA:
-
Option Explicit
-
-
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
-
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
-
Private Const BIF_RETURNFSANCESTORS As Long = &H8
-
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
-
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
-
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
-
Private Const MAX_PATH As Long = 260
-
-
Type BrowseInfo
-
hOwner As Long
-
pidlRoot As Long
-
pszDisplayName As String
-
lpszINSTRUCTIONS As String
-
ulFlags As Long
-
lpfn As Long
-
lParam As Long
-
iImage As Long
-
End Type
-
-
Type SHFILEOPSTRUCT
-
hwnd As Long
-
wFunc As Long
-
pFrom As String
-
pTo As String
-
fFlags As Integer
-
fAnyOperationsAborted As Boolean
-
hNameMappings As Long
-
lpszProgressTitle As String
-
End Type
-
-
Declare Function SHGetPathFromIDListA Lib "shell32.dll" ( _
-
ByVal pidl As Long, _
-
ByVal pszBuffer As String) As Long
-
-
Declare Function SHBrowseForFolderA Lib "shell32.dll" ( _
-
lpBrowseInfo As BrowseInfo) As Long
-
-
Public Sub Save_To_Where()
-
-
Dim sFolderName As String
-
Dim sFileName As String
-
Dim sdefult As String
-
-
sdefult = "M.I.E Export to CSV - " & Application.UserName & " - " _
-
& Round((Timer), 0)
-
-
sFolderName = BrowseFolder("Save Text File Where?")
-
If sFolderName = "" Then
-
Exit Sub
-
Else
-
sFileName = InputBox("Entre the file name you would like to use", "File Name", sdefult)
-
If Len(sFileName) = 0 Then
-
Exit Sub
-
End If
-
End If
-
-
SaveAsText sFolderName, sFileName
-
-
End Sub
-
-
'''Fuction to get directory
-
Function BrowseFolder(Optional Caption As String = "") As String
-
-
Dim BrowseInfo As BrowseInfo
-
Dim FolderName As String
-
Dim ID As Long
-
Dim Res As Long
-
-
With BrowseInfo
-
.hOwner = 0
-
.pidlRoot = 0
-
.pszDisplayName = String$(MAX_PATH, vbNullChar)
-
.lpszINSTRUCTIONS = Caption
-
.ulFlags = BIF_RETURNONLYFSDIRS
-
.lpfn = 0
-
End With
-
-
FolderName = String$(MAX_PATH, vbNullChar)
-
-
ID = SHBrowseForFolderA(BrowseInfo)
-
-
If ID Then
-
Res = SHGetPathFromIDListA(ID, FolderName)
-
If Res Then
-
BrowseFolder = Left$(FolderName, InStr(FolderName, _
-
vbNullChar) - 1)
-
End If
-
End If
-
-
End Function
-
-
Public Sub SaveAsText(sFolder As String, sName As String)
-
-
On Error GoTo ErrorHandler
-
-
Application.ScreenUpdating = False
-
-
Selection.Copy
-
-
Workbooks.Add
-
ActiveWorkbook.Sheets(1).Paste
-
ActiveWorkbook.SaveAs Filename:=sFolder & "\" & sName & ".csv", FileFormat:=xlCSVMSDOS
-
Application.DisplayAlerts = False
-
ActiveWorkbook.Close
-
Application.DisplayAlerts = True
-
Application.ScreenUpdating = True
-
-
Exit Sub
-
-
'''Error handerling
-
ErrorHandler:
-
If Err.Number = 1003 Then
-
MsgBox "Error, did you use <,>,?,[,], :, | or *" _
-
& vbNewLine & "Make sure the folder exists" _
-
& vbNewLine & "Make sure the ile/path name is not onger than 218 letters" _
-
& vbNewLine & "Make sure the folder is not read only", _
-
vbOKOnly, "Error Exporting Text File"
-
Exit Sub
-
Else
-
MsgBox "An unexpected error occured, export aborted", vbOKOnly, "Error Exporting Text File"
-
Exit Sub
-
End If
-
-
End Sub
