Unable to save date in csv file if date is greater than 10
Results 1 to 3 of 3

Thread: Unable to save date in csv file if date is greater than 10
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member
    Join Date
    Nov 2010
    Location
    India
    Posts
    8
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Unable to save date in csv file if date is greater than 10

    I am having a macro which opens multiple csv files one by one, extracts date from the file name and store this extracted date in a new rightmost column in each file. Then the file is saved in the csv format. All the revised files are then merged in one file as database and then I perform various tasks on the merged file.

    My problem is, nowadays, in excel 2010, whenever the date is greater than 10, the date is stored in text format and not in the date format in csv file which I am unable to resolve.
    In excel 2007 this problem never occurred.

    Can you please help me to correct my code ?

    The CSV filenames are like AB01042019.CSV, AB26102019.CSV etc. The file looks like as follows:

    Code NAME English Physics Maths chemistry
    1 A 12 12 16 14
    2 B 14 13 16 18
    3 C 9 6 0 18
    4 D 10 12 2 18
    5 E 12 15 19 16
    6 F 13 9 8 11
    7 G 16 16 12 14
    8 H 8 12 14 11
    9 I 16 11 13 15


    The code is as follows:
    Code:
    Const FileFilter = "*.CSV"
    Sub Getfilename()
        Dim fd As FileDialog
        Dim fldpath As String
        Set fd = Application.FileDialog(msoFileDialogFolderPicker)
        With fd
            .AllowMultiSelect = False
            .Filters.Clear
            If .Show Then
                fldpath = .SelectedItems(1)
            End If
        End With
        
        
    
    
    If fldpath <> "" Then
        If Len(Dir(fldpath, vbDirectory)) <> 0 Then
          startfolder = fldpath
          Dim filename As String
          filename = Getindfilename(fldpath)
          
        Else
            MsgBox "Invalid Path"
        End If
    Else
        MsgBox "Please Enter The Folder Path Containing Workbook"
        Exit Sub
    End If
    
    
    
    
    
    
    End Sub
    
    
    Private Function Getindfilename(foldpath As String) As String
        Dim i As Long, j As Long, arr() As String, wkb As Workbook, wks As Worksheet
     
        ExtractFolder foldpath, arr()
     
        On Error Resume Next
        j = -1: j = UBound(arr)
        On Error GoTo 0
     
        For i = 0 To j
            
           ProcessFiles (arr(i))
        Next
    End Function
    Sub ExtractFolder(Folder As String, arr() As String)
        Dim i As Long, objFS As Object, objFolder As Object, obj As Object
     
        Set objFS = CreateObject("Scripting.FileSystemObject")
        Set objFolder = objFS.GetFolder(Folder)
     
        For Each obj In objFolder.SubFolders
            ExtractFolder obj.Path, arr()
        Next
     
        For Each obj In objFolder.Files
            If obj.Name Like FileFilter Then
                On Error Resume Next
                i = 0: i = UBound(arr) + 1
                On Error GoTo 0
                ReDim Preserve arr(i)
                arr(i) = objFolder.Path & Application.PathSeparator & obj.Name
                'Debug.Print arr(i)
            End If
        Next
    End Sub
    
    
    Sub ProcessFiles(filename As String)
    
    
    '   Import the file
        Workbooks.OpenText filename:=filename, _
            Origin:=xlWindows, _
            StartRow:=1, _
            DataType:=xlFixedWidth
        
           
        
        'insert date in last column
        ActiveCell.CurrentRegion.Select
        totalcolumns = Selection.Columns.Count
        totalrows = Selection.Rows.Count
        Range("a1").Select
        Selection.End(xlToRight).Select 'Cursor moves to rightmost column with data
        ActiveCell.Offset(0, 1).Range("A1").Select
        ActiveCell.FormulaR1C1 = "Date"
        ActiveCell.Offset(1, 0).Range("A1").Select
        
        'get date from filename
        shortfilename = Right(filename, 12)
    
    
        'changed so that it can take date format
        filedate = Mid(shortfilename, 3, 2) & "-" _
                   & Mid(shortfilename, 5, 2) & "-" _
                   & Mid(shortfilename, 7, 2)
        
          
        ActiveCell.FormulaR1C1 = filedate
      
        Range("a1").Select
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, totalcolumns).Range("A1").Select
        Selection.Cells(ActiveCell).Value = "x"
        Selection.End(xlUp).Select
        Selection.End(xlUp).Select
        
        Application.CutCopyMode = False
        Selection.Copy
        Range(Selection, Selection.End(xlDown)).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Selection.Columns.AutoFit
        
        
    
    
        'This procedure closes all workbooks except active workbook running in this example
        For Each w In Workbooks
            If w.Name <> ThisWorkbook.Name Then
            w.Close savechanges:=True
            End If
        Next w
            
    
    
     
    Set NewBook = Workbooks.Add
    Do
        fName = Application.GetSaveAsFilename
    Loop Until fName <> False
    
    
    
    
    
    
        
    End Sub
    Last edited by RoryA; Aug 13th, 2019 at 03:11 AM. Reason: Code tags

  2. #2
    New Member
    Join Date
    Nov 2010
    Location
    India
    Posts
    8
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Unable to save date in csv file if date is greater than 10

    Hi,
    Can anybody help ?

  3. #3
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    5,732
    Post Thanks / Like
    Mentioned
    65 Post(s)
    Tagged
    14 Thread(s)

    Default Re: Unable to save date in csv file if date is greater than 10

    Change this

    Code:
    'changed so that it can take date format
        filedate = Mid(shortfilename, 3, 2) & "-" _
                   & Mid(shortfilename, 5, 2) & "-" _
                   & Mid(shortfilename, 7, 2)          
        ActiveCell.FormulaR1C1 = filedate
    By this
    Code:
    'changed so that it can take date format
        filedate = Mid(shortfilename, 3, 2) & "-" _
                   & Mid(shortfilename, 5, 2) & "-" _
                   & Mid(shortfilename, 7, 4)          
        ActiveCell.value = cdate(filedate)
    Try and tell me.
    Last edited by DanteAmor; Aug 17th, 2019 at 11:39 PM.
    Regards Dante Amor

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •