Removing Spaces in File Names

[Nithya]

Hi ,

I am using the below code for creating the name of the output files(this macro will convert xls to csv). The names are populated as below.

tempName = myPath & myFiles(fCtr) & "_" & Trim(.Name) & ".csv"
                            
                            Do
                                If Dir(tempName) = "" Then
                                    Exit Do
                                Else
                                    tempName = myPath & myFiles(fCtr) & "_" & Trim(.Name) & "_" _
                                          & Format(Time, "hhmmss") & ".csv"

Actual_XlsName_ worksheet name .csv

Test_xls_sheet test1
Test1_xls_sheet test2
Test2_xls_sheet test3

Note:- sheet test1,sheet test2,sheet test3 are the worksheet names.
I need to remove the spaces in the worksheet name, the output should be as below.



Test_xls_sheettest1 or Test_xls_sheet_test1
Test1_xls_sheettest2 or Test1_xls_sheet_test2
Test2_xls_sheettest3 or Test2_xls_sheet_test3


Complete Code

Option Explicit
Sub Excel_to_CSV()

    Application.ScreenUpdating = False

    Dim myFiles() As String
    Dim fCtr As Long
    Dim myFile As String
    Dim myPath As String
    Dim tempWkbk As Workbook
    Dim logWks As Worksheet
    Dim tempName As String
    Dim Wks As Worksheet
    Dim oRow As Long

    'change to point at the folder to check
    myPath = "C:\temp"
    If Right(myPath, 1) <> "\" Then
        myPath = myPath & "\"
    End If

    myFile = Dir(myPath & "*.xls")
    If myFile = "" Then
        MsgBox "no files found"
        Exit Sub
    End If

    Set logWks = Workbooks.Add(1).Worksheets(1)
    logWks.Range("a1").Resize(1, 3).Value _
        = Array("WkbkName", "WkSheetName", "CSV Name")

    'get the list of files
    fCtr = 0
    Do While myFile <> ""
        fCtr = fCtr + 1
        ReDim Preserve myFiles(1 To fCtr)
        myFiles(fCtr) = myFile
        myFile = Dir()
    Loop

    If fCtr > 0 Then
        oRow = 1
        For fCtr = LBound(myFiles) To UBound(myFiles)
            Set tempWkbk = Nothing
            On Error Resume Next
            Set tempWkbk = Workbooks.Open(Filename:=myPath & myFiles(fCtr))
            On Error GoTo 0
            If tempWkbk Is Nothing Then
                logWks.Cells(oRow, "A").Value = "Error Opening: " _
                                                      & myFiles(fCtr)
                oRow = oRow + 1
            Else
                For Each Wks In tempWkbk.Worksheets
                    With Wks
                        If Application.CountA(.UsedRange) = 0 Then
                            'do nothing
                        Else
                            .Copy 'to a new workbook
                            tempName = myPath & myFiles(fCtr) & "_" & Trim(.Name) & ".csv"
                            
                            Do
                                If Dir(tempName) = "" Then
                                    Exit Do
                                Else
                                    tempName = myPath & myFiles(fCtr) & "_" & Trim(.Name) & "_" _
                                          & Format(Time, "hhmmss") & ".csv"
                                End If
                            Loop
                            oRow = oRow + 1
                            With ActiveWorkbook
                                .SaveAs Filename:=tempName, FileFormat:=xlCSV
                                .Close SaveChanges:=False
                            End With
                            logWks.Cells(oRow, "A").Value = myFiles(fCtr)
                            logWks.Cells(oRow, "b").Value = .Name
                            logWks.Cells(oRow, "C").Value = tempName
                        End If
                    End With
                Next Wks
                tempWkbk.Close SaveChanges:=False
            End If
        Next fCtr
    End If

    With logWks.UsedRange
        .AutoFilter
        .Columns.AutoFit
    End With

    Application.ScreenUpdating = True

End Sub

Please let me know how to remove the spaces and generate the file names.

Regards,
Nithya

 

[Biz]

Hi,

I think you need replace function. Have look at website below

http://excel.bigresource.com/Track/excel-wmc48bk0/

Biz

 

[Nithya]

Hey I used the below code it is removing the spaces

WorksheetFunction.Substitute(trim(.Name), " ", "_")