0

EDITED 14 may

After a lot of reading I finally understand the basics of VBA. I have created the macro below, but it still isn't working, it won't insert the csv files. Afte this macro is finished the saved files are all empty. With debug.print I confirmed the string to the files is complete, but still something is missing?

Can anybody help me fix this problem

thanks in advance

Sub CSVimporterennaarxlsx()
    'On Error Resume Next
    'declare variable
    Application.ScreenUpdating = False
    Dim strpath As String
    Dim fmn As Integer
    Dim lmn As Integer
    Dim csvname As String
    Dim strpathcsvname As String
    'active workbook pathway
    strpath = Application.ActiveWorkbook.Path
    'ask user for first and last number
    fmn = InputBox("first mouse number")
    lmn = InputBox("last mouse number")
    'einde sub if inputbox is empty
'    If fmn = "" Then
'    MsgBox "No first mouse number"
'    Exit Sub
'    End If
'    If lmn = "" Then
'    MsgBox "No Last mouse number"
'    Exit Sub
'    End If

    'assign variables

    'loop all the files
     For fmn = fmn To lmn
     csvname = "m" & fmn
     strpathcsvname = strpath & "\" & csvname & ".csv"
     'input of csv file
'        ActiveSheet.Cells.Delete

        With ActiveSheet.QueryTables.Add(Connection:= _
            "TEXT;" + strpathcsvname, _
            Destination:=Range(A1))
'filename without extension
            .Name = csvname
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 850
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
            1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
            , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
            1, 1)
            .TextFileDecimalSeparator = "."
            .TextFileThousandsSeparator = ","
            .TextFileTrailingMinusNumbers = True
        End With
    Call CsvToXlsx(ByVal csvname, strpath)
    Next fmn
Application.DisplayAlerts = True
    End Sub

    Sub CsvToXlsx(ByVal csvname, strpath)
    ChDir (strpath & "/verwerkt")
     Application.DisplayAlerts = False
    csvname = csvname & ".xlsx"
      ActiveWorkbook.SaveAs Filename:=csvname, FileFormat:=51

    End Sub
BtotheE
  • 13
  • 6
  • will this help? http://stackoverflow.com/questions/10551353/saving-excel-worksheet-to-csv-files-with-filenameworksheet-name-using-vb – jpr Apr 23 '14 at 09:17

1 Answers1

2

try just to open the .csv file and save it as an .xls file

Sub CsvToXls (csvname)
  Workbooks.Open Filename:=csvname
  xlsname = Replace(csvname, ".csv",".xls")  
  ActiveWorkbook.SaveAs Filename:=xlsname , FileFormat:=xlNormal
End Sub

then, to iterate for all .csv files in a dir

Sub AllCsvToXls(dirname)        
    Dim csv As Variant 
    csv = Dir(dirname & "\*.csv")
    While (csv <> "")
      CsvToXls (dirname & "\" & csv)
      csv = Dir
    Wend  
End Sub

and finally, invoke it ...

AllCsvToXls(ThisWorkbook.Path)
PA.
  • 28,486
  • 9
  • 71
  • 95
  • 1
    +1 very clean code. I suggest using `.OpenText` method though since OP set `True` for `Comma` and `Tab` delimiters. – L42 Apr 23 '14 at 09:50
  • thanks a lot for answering so fast, Is there any source where I can find explanation for the code. – BtotheE Apr 23 '14 at 09:59
  • 1
    The code is (in my opinion which is obviously biased because I wrote myself the code) very readable and understandable. If you have trouble with the basic programming structures (`Sub`, `While`) and library functions (`Dir`, `Replace`) it uses, I suggest you to grab a good book on VBA and start studying. – PA. Apr 23 '14 at 10:40
  • What is su ? I assume it is an other forum? I already bought a book for VBA, So I hope I can solve this problem myself in about a week or so. – BtotheE Apr 24 '14 at 07:34
  • SU = SuperUser ( http:\\superuser.com ) – PA. Apr 24 '14 at 11:04
  • @PA If been trying to modify my code and to add yours but i have a few questions,with the code u provided. I understand what it does right now. But i don't have a clue how to concatenate the functions. Does it have to be different subs? – BtotheE Apr 24 '14 at 11:15
  • yes, two different subs, and you can place the invoking call as an independent macro. – PA. Apr 24 '14 at 11:29
  • @PA after learning a lot I have modified a lot, but still 1 thing doesn't work the new code has been pasted above – BtotheE May 14 '14 at 12:38