Selection to CSV

18 June 2006 by Ross McLean

Obviously you could adapter it to do what ever type of text file you like (well, and Excel can handle)

PLAIN TEXT
VBA:
  1. Option Explicit
  2.  
  3. Private Const BIF_RETURNONLYFSDIRS As Long = &H1
  4. Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
  5. Private Const BIF_RETURNFSANCESTORS As Long = &H8
  6. Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
  7. Private Const BIF_BROWSEFORPRINTER As Long = &H2000
  8. Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
  9. Private Const MAX_PATH As Long = 260
  10.  
  11. Type BrowseInfo
  12. hOwner As Long
  13. pidlRoot As Long
  14. pszDisplayName As String
  15. lpszINSTRUCTIONS As String
  16. ulFlags As Long
  17. lpfn As Long
  18. lParam As Long
  19. iImage As Long
  20. End Type
  21.  
  22. Type SHFILEOPSTRUCT
  23. hwnd As Long
  24. wFunc As Long
  25. pFrom As String
  26. pTo As String
  27. fFlags As Integer
  28. fAnyOperationsAborted As Boolean
  29. hNameMappings As Long
  30. lpszProgressTitle As String
  31. End Type
  32.  
  33. Declare Function SHGetPathFromIDListA Lib "shell32.dll" ( _
  34. ByVal pidl As Long, _
  35. ByVal pszBuffer As String) As Long
  36.  
  37. Declare Function SHBrowseForFolderA Lib "shell32.dll" ( _
  38. lpBrowseInfo As BrowseInfo) As Long
  39.  
  40. Public Sub Save_To_Where()
  41.  
  42. Dim sFolderName As String
  43. Dim sFileName As String
  44. Dim sdefult As String
  45.  
  46. sdefult = "M.I.E Export to CSV - " & Application.UserName & " - " _
  47. & Round((Timer), 0)
  48.  
  49. sFolderName = BrowseFolder("Save Text File Where?")
  50. If sFolderName = "" Then
  51. Exit Sub
  52. Else
  53. sFileName = InputBox("Entre the file name you would like to use", "File Name", sdefult)
  54. If Len(sFileName) = 0 Then
  55. Exit Sub
  56. End If
  57. End If
  58.  
  59. SaveAsText sFolderName, sFileName
  60.  
  61. End Sub
  62.  
  63. '''Fuction to get directory
  64. Function BrowseFolder(Optional Caption As String = "") As String
  65.  
  66. Dim BrowseInfo As BrowseInfo
  67. Dim FolderName As String
  68. Dim ID As Long
  69. Dim Res As Long
  70.  
  71. With BrowseInfo
  72. .hOwner = 0
  73. .pidlRoot = 0
  74. .pszDisplayName = String$(MAX_PATH, vbNullChar)
  75. .lpszINSTRUCTIONS = Caption
  76. .ulFlags = BIF_RETURNONLYFSDIRS
  77. .lpfn = 0
  78. End With
  79.  
  80. FolderName = String$(MAX_PATH, vbNullChar)
  81.  
  82. ID = SHBrowseForFolderA(BrowseInfo)
  83.  
  84. If ID Then
  85. Res = SHGetPathFromIDListA(ID, FolderName)
  86. If Res Then
  87. BrowseFolder = Left$(FolderName, InStr(FolderName, _
  88. vbNullChar) - 1)
  89. End If
  90. End If
  91.  
  92. End Function
  93.  
  94. Public Sub SaveAsText(sFolder As String, sName As String)
  95.  
  96. On Error GoTo ErrorHandler
  97.  
  98. Application.ScreenUpdating = False
  99.  
  100. Selection.Copy
  101.  
  102. Workbooks.Add
  103. ActiveWorkbook.Sheets(1).Paste
  104. ActiveWorkbook.SaveAs Filename:=sFolder & "\" & sName & ".csv", FileFormat:=xlCSVMSDOS
  105. Application.DisplayAlerts = False
  106. ActiveWorkbook.Close
  107. Application.DisplayAlerts = True
  108. Application.ScreenUpdating = True
  109.  
  110. Exit Sub
  111.  
  112. '''Error handerling
  113. ErrorHandler:
  114. If Err.Number = 1003 Then
  115. MsgBox "Error, did you use <,>,?,[,], :, | or *" _
  116. & vbNewLine & "Make sure the folder exists" _
  117. & vbNewLine & "Make sure the ile/path name is not onger than 218 letters" _
  118. & vbNewLine & "Make sure the folder is not read only", _
  119. vbOKOnly, "Error Exporting Text File"
  120. Exit Sub
  121. Else
  122. MsgBox "An unexpected error occured, export aborted", vbOKOnly, "Error Exporting Text File"
  123. Exit Sub
  124. End If
  125.  
  126. End Sub

Related posts:

  1. Click to install Addin
  2. Custom File Extensions
  3. Combine Formulas into one cell

Tags: , ,
Categories: Code • Permalink • No Comments »

Submit a Comment