[a82204]

Hi Everyone,
This is my first question on this forum.
I am looking forward to a solution of the current project I am working on to Edit a CSV/EXCEL file which is located on my Desktop.

This file is created from a word Document which has data in tables. I was able to convert the data into CSV file it gets saved automatically on my desktop with the following VB code, however I want to edit the file further.

I have attached the file below which you can use to see how it converts the data into CSV. For your references.

What I am looking for? :-

1) I want to do "Text to Column" to separate the data in various Cells in the excel sheet. I chose COMMA (,)under Delimited function and it gets sorted perfectly.
2) I also want to give Headings to those Cells as following:-

Name Company Title Email/Phone
3) Save & Close the file.

I need to make these changes in the file after its saved with the code given below:-
Here is the Code--

Option Explicit

Private Sub Main()
    Dim FileName As String
    Dim FileTitle As String
    With New CDlgOpen
        .DialogTitle = "Word document to use"
        .Filter = "Word documents (*.doc)|*.doc"
        .FilterIndex = 1
        .InitDir = CurDir$()
        If .ShowOpen(0) Then Exit Sub
        FileName = .FileName
        FileTitle = .FileTitle
        
        
    End With
    
    
    
    Dim Num As String
    Dim TableNumber As Long
    Do
        Num = InputBox("Enter a numeric value 1 to n", _
                       "Table number to dump", _
                       "1")
        If StrPtr(Num) = 0 Then Exit Sub
    Loop Until IsNumeric(Num)
    TableNumber = CLng(Num)
    
    Dim ShortLine As Long
    Do
        Num = InputBox("Enter a numeric value 1 to n, 1 to use " _
                     & "all table rows", _
                       "Discard rows with less than n fields", _
                       "2")
        If StrPtr(Num) = 0 Then Exit Sub
    Loop Until IsNumeric(Num)
    ShortLine = CLng(Num)
    
    Dim WordApp As Object 'Word.Application, but we're late binding here.
    Dim Lines() As String
    Set WordApp = CreateObject("Word.Application")
    With WordApp
        With .Documents.Open(FileName, ReadOnly:=True)
            With .Tables(TableNumber)
                Lines = Split(.ConvertToText(wdSeparateByTabs).Text, vbCr)
            End With
            .Close savechanges:=False
        End With
        .Quit
    End With
    
    Const ssfDESKTOP = 0
    Dim OutputName As String
    Dim Line As Long
    Dim Fields() As String
    Dim Field As Long
    With CreateObject("Shell.Application").Namespace(ssfDESKTOP).Self
        OutputName = .Path & "\" & FileTitle & "." & CStr(TableNumber) & ".csv"
    End With
    With New Scripting.FileSystemObject
        With .CreateTextFile(OutputName, True, unicode:=True)
            For Line = 0 To UBound(Lines)
                Fields = Split(Lines(Line), vbTab)
                If UBound(Fields) >= ShortLine Then
                    For Field = 0 To UBound(Fields)
                        If Len(Trim$(Fields(Field))) < 1 Then
                            Fields(Field) = """N/A"""
                        Else
                            Fields(Field) = """" _
                                          & Replace(Fields(Field), """", """""") _
                                          & """"
                        End If
                    Next
                    .WriteLine Join$(Fields, ",")
                End If
            Next
            .Close
        End With
    End With
    
  


    
    MsgBox "I think your CSV is Ready to use  :)"
    MsgBox "Hey I just found it, its right there on your Desktop :P"
End Sub

Here is the CLASS MODULE Code:-

Option Explicit
'
'Common Dialog Open without the CommonDialog OCX.
'
'No dependencies.
'

Public Enum FileOpenConstants
    'ShowOpen, ShowSave constants.
    cdlOFNAllowMultiselect = &H200&
    cdlOFNCreatePrompt = &H2000&
    cdlOFNExplorer = &H80000
    cdlOFNExtensionDifferent = &H400&
    cdlOFNFileMustExist = &H1000&
    cdlOFNHideReadOnly = &H4&
    cdlOFNLongNames = &H200000
    cdlOFNNoChangeDir = &H8&
    cdlOFNNoDereferenceLinks = &H100000
    cdlOFNNoLongNames = &H40000
    cdlOFNNoReadOnlyReturn = &H8000&
    cdlOFNNoValidate = &H100&
    cdlOFNOverwritePrompt = &H2&
    cdlOFNPathMustExist = &H800&
    cdlOFNReadOnly = &H1&
    cdlOFNShareAware = &H4000&
End Enum
'Case-preserving hack:
#If False Then
    Dim cdlOFNAllowMultiselect, cdlOFNCreatePrompt, cdlOFNExplorer, cdlOFNExtensionDifferent
    Dim cdlOFNFileMustExist, cdlOFNHideReadOnly, cdlOFNLongNames, cdlOFNNoChangeDir
    Dim cdlOFNNoDereferenceLinks, cdlOFNNoLongNames, cdlOFNNoReadOnlyReturn
    Dim cdlOFNNoValidate, cdlOFNOverwritePrompt, cdlOFNPathMustExist, cdlOFNReadOnly
    Dim cdlOFNShareAware
#End If

Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    Flags As FileOpenConstants
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Private Declare Function GetOpenFileName Lib "comdlg32" Alias "GetOpenFileNameA" ( _
    ByRef lpofn As OPENFILENAME) As Long


'ShowOpen properties.
Public DefaultExt As String 'Value excludes period.
Public DialogTitle As String
Public FileName As String
Public FileTitle As String
Public Filter As String
Public FilterIndex As Long
Public Flags As FileOpenConstants
Public InitDir As String
Public MaxFileSize As Long

Private OF As OPENFILENAME

Private Sub InitOpenFile(ByVal hWnd As Long)
    With OF
        .hwndOwner = hWnd
        .lpstrFilter = Replace$(Filter, "|", vbNullChar) & vbNullChar
        .nFilterIndex = FilterIndex
        .lpstrFile = FileName & String$(256 - Len(FileName), 0)
        .nMaxFile = MaxFileSize
        .lpstrFileTitle = String$(256, 0)
        .nMaxFileTitle = 256
        .lpstrInitialDir = InitDir
        .lpstrTitle = DialogTitle
        .Flags = Flags
        .lpstrDefExt = DefaultExt
    End With
End Sub

Private Sub ExtractOpenFile()
    With OF
        FileName = .lpstrFile
        FileTitle = ""
        If (Flags And cdlOFNAllowMultiselect) = 0 Then
            FileName = Left$(FileName, InStr(FileName, vbNullChar) - 1)
            If (Flags And cdlOFNNoValidate) = 0 Then
                FileTitle = Left$(.lpstrFileTitle, _
                                  InStr(.lpstrFileTitle, vbNullChar) - 1)
            End If
        End If
        Flags = .Flags
    End With
End Sub

Public Function ShowOpen(ByVal hWnd As Long) As Boolean
    'Returns True on Cancel or error.
    InitOpenFile hWnd
    ShowOpen = GetOpenFileName(OF) = 0
    If Not ShowOpen Then
        ExtractOpenFile
    End If
End Function

Private Sub Class_Initialize()
    With OF
        .lStructSize = LenB(OF)
        .hInstance = App.hInstance
    End With
    Filter = "All files (*.*)|*.*"
    FilterIndex = 1
    MaxFileSize = 256
End Sub

Looking forward for a solution to this one.

Thanks in advance. (I am very New to VB)

[modi123_1]

Please refrain from duplicate posts! Thanks!