Avatar of haravallabhan
haravallabhan
Flag for India asked on

Excel workbook sheets as seperate tab delimited files

Hi,

I have an Excel file with lots of sheets. I want to save/export each sheet as a seperate tab-demilited text file is there any shortcut way to do it, or VB Macro or Add-in?

Thanks
Microsoft ExcelMicrosoft OfficeVB Script

Avatar of undefined
Last Comment
haravallabhan

8/22/2022 - Mon
ASKER CERTIFIED SOLUTION
Jornak

THIS SOLUTION ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
GET A PERSONALIZED SOLUTION
Ask your own question & get feedback from real experts
Find out why thousands trust the EE community with their toughest problems.
haravallabhan

ASKER
GR8, Thanks but it is saving as an CSV file rather than tab delimited file. how do I save it as an tab delimited file ?  It is asking for options what symbol should i use for TSV ?

"/t"  Chr(9)  are not working is there an ASCII code for tab?
Jornak

' ---------------------- Directory Choosing Helper Functions -----------------------
' Excel and VBA do not provide any convenient directory chooser or file chooser
' dialogs, but these functions will provide a reference to a system DLL
' with the necessary capabilities
Private Type BROWSEINFO ' used by the function GetFolderName
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
    Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
    Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Function GetFolderName(Msg As String) As String
' returns the name of the folder selected by the user
Dim bInfo As BROWSEINFO, path As String, r As Long
Dim X As Long, pos As Integer
    bInfo.pidlRoot = 0& ' Root folder = Desktop
    If IsMissing(Msg) Then
        bInfo.lpszTitle = "Select a folder."
        ' the dialog title
    Else
        bInfo.lpszTitle = Msg ' the dialog title
    End If
    bInfo.ulFlags = &H1 ' Type of directory to return
    X = SHBrowseForFolder(bInfo) ' display the dialog
    ' Parse the result
    path = Space$(512)
    r = SHGetPathFromIDList(ByVal X, ByVal path)
    If r Then
        pos = InStr(path, Chr$(0))
        GetFolderName = Left(path, pos - 1)
    Else
        GetFolderName = ""
    End If
End Function
'---------------------- END Directory Chooser Helper Functions ----------------------

Public Sub DoTheExport()
Dim FName As Variant
Dim Sep As String
Dim wsSheet As Worksheet
Dim nFileNum As Integer
Dim csvPath As String


Sep = Char(9)
'csvPath = InputBox("Enter the full path to export CSV files to: ")

csvPath = GetFolderName("Choose the folder to export CSV files to:")
If csvPath = "" Then
    MsgBox ("You didn't choose an export directory. Nothing will be exported.")
    Exit Sub
End If

For Each wsSheet In Worksheets
wsSheet.Activate
nFileNum = FreeFile
Open csvPath & "\" & _
  wsSheet.Name & ".csv" For Output As #nFileNum
ExportToTextFile CStr(nFileNum), Sep, False
Close nFileNum
Next wsSheet

End Sub



Public Sub ExportToTextFile(nFileNum As Integer, _
Sep As String, SelectionOnly As Boolean)

Dim WholeLine As String
Dim RowNdx As Long
Dim ColNdx As Integer
Dim StartRow As Long
Dim EndRow As Long
Dim StartCol As Integer
Dim EndCol As Integer
Dim CellValue As String

Application.ScreenUpdating = False
On Error GoTo EndMacro:

If SelectionOnly = True Then
With Selection
StartRow = .Cells(1).Row
StartCol = .Cells(1).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(.Cells.Count).Column
End With
Else
With ActiveSheet.UsedRange
StartRow = .Cells(1).Row
StartCol = .Cells(1).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(.Cells.Count).Column
End With
End If

For RowNdx = StartRow To EndRow
WholeLine = ""
For ColNdx = StartCol To EndCol
If Cells(RowNdx, ColNdx).Value = "" Then
CellValue = ""
Else
CellValue = Cells(RowNdx, ColNdx).Value
End If
WholeLine = WholeLine & CellValue & Sep
Next ColNdx
WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
Print #nFileNum, WholeLine
Next RowNdx

EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True

End Sub

Open in new window


Replaced asking for delimiter with Char(9) [tab].
haravallabhan

ASKER
hi, replacing Sep = Chr(9) or Char (9) is not helping either, it gives compilation error or saving as file without any delimiters.
Experts Exchange is like having an extremely knowledgeable team sitting and waiting for your call. Couldn't do my job half as well as I do without it!
James Murphy
Jornak

Try vbTab instead of Char(9), perhaps.
haravallabhan

ASKER
Great