It took me a while but I think I have a potential solution. I set up a test workbook with some dates formatted as text and the following code seems to work.
(Your system has different date/time regional settings; I suspect that may complicate things. But for now give this a try.)
The lines I've changes are marked with
; <--- Added.
Code: Select all
; Constants
xlCellTypeConstants := 2
xlDelimited := 1 ; <--- Added
xlDMYFormat := 4 ; <--- Added
xlPasteValues := -4163
xlPasteSpecialOperationMultiply := 4
; Select the workbook to use.
FileSelectFile, wbkPath, 1, %A_ScriptDir%, Open, Workbooks (*.xlsx; *.xls)
if (ErrorLevel) ; User pressed cancel.
return
; Store the workbook directory.
SplitPath, % wbkPath,, saveDir
; Create an instance of Excel
xlApp := ComObjCreate("Excel.Application")
; Make Excel visible. This line can be removed once you check that this script is working properly.
xlApp.Visible := true
; Change decimal separator to comma.
xlApp.DecimalSeparator := ","
xlApp.ThousandsSeparator := " "
xlApp.UseSystemSeparators := false
; Open the source workbook.
wbkSrc := xlApp.Workbooks.Open(wbkPath)
; Pick an unused cell. (The last cell in column A.)
rConst := wbkSrc.Worksheets(1).Columns(1).Cells( wbkSrc.Worksheets(1).Columns(1).Cells.Count )
; Set the cell value to 1.
rConst.Value := 1
; Get a range of all cells of type: Constants.
rng := wbkSrc.Worksheets(1).Cells.SpecialCells(xlCellTypeConstants)
; Change number format to "General".
rng.NumberFormat := "General"
; Copy.
rConst.Copy
; Paste special.
rng.PasteSpecial(xlPasteValues, xlPasteSpecialOperationMultiply)
; Clear the cell that was set earlier.
rConst.Clear
; Change decimal separator to dot.
xlApp.DecimalSeparator := "."
xlApp.ThousandsSeparator := ","
; ***I'm not sure what columns need to be changed in your workbook.***
; This changes the number format in column 'C' (the 3rd column).
wbkSrc.Worksheets(1).Columns(3).NumberFormat := "0.00"
; Convert dates stored as text to dates. (Column A)
SA := ComObjArray(0xC, 2), SA[0] := 1, SA[1] := xlDMYFormat ; <--- Added
wbkSrc.Worksheets(1).Columns(1).Cells.TextToColumns(wbkSrc.Worksheets(1).Range("A1"), xlDelimited,,,,,,,,, SA) ; <--- Added
wbkSrc.Worksheets(1).Columns(1).NumberFormat := "m/d/yyyy" ; <--- Added
; Get the header row from sheet1.
HeaderRow := wbkSrc.Worksheets(1).Rows(1)
; Get cell A2 on sheet1.
myCell := wbkSrc.Worksheets(1).Range("A2")
; Loop until 'myCell' is blank.
while myCell.Formula != "" {
; Get a continuous range of cells based on which cells in column A are not blank.
rng := FindContinuousRange(myCell)
; Get the name to use for the new workbook.
wbkNewName := myCell.Offset(0, 1).Text
; Add a new blank workbook.
wbkNew := xlApp.Workbooks.Add()
; Copy the header into the new workbook.
HeaderRow.Copy( wbkNew.Worksheets(1).Range("A1") )
; Copy 'rng' into the new workbook.
rng.Copy( wbkNew.Worksheets(1).Range("A2") )
; Autosize all columns on sheet1 in the new workbook.
wbkNew.Worksheets(1).Columns.AutoFit
; SaveAs
wbkNew.SaveAs(saveDir "\" wbkNewName ".xlsx")
; Close the new workbook.
;~ MsgBox ; Pause to see the workbook.
wbkNew.Close()
; Get the cell to use for the next loop. (down 2 rows in column A)
rng := rng.Columns(1)
myCell := rng.Cells(rng.Cells.Count).Offset(2, 0)
}
; Close the source workbook. 0 = Do not save changes.
wbkSrc.Close(0)
xlApp.UseSystemSeparators := true
; Quit Excel.
xlApp.Quit()
return
FindContinuousRange(rCell) {
; Reference http://sitestory.dk/excel_vba/find-next-empty-cell.htm
static xlDown := -4121
; If the cell just below is blank.
if (rCell.Offset(1, 0).Formula = "")
return rCell.EntireRow
; Finds the last cell with content.
; .End(xlDown) is like pressing CTRL + down.
else
return rCell.Application.Range(rCell, rCell.End(xlDown)).EntireRow
}
References and further reading:
When I was searching for answers, many people suggested using
DateValue(). But that is a VBA function (not part of Excel, its part of the VBA programming language) so we can't use if from AHK.