CsvImpExcel.vbs

Dim oArgs, oWSH, oFSO, oXLS, oWbk, oSht

Call Main

Sub Main
  Set oFSO = CreateObject("Scripting.FileSystemObject")
  Set oArgs = WScript.Arguments
  For i = 0 to oArgs.Count - 1
    Call CsvImpExcel(oArgs(i))
  Next
End Sub

Sub CsvImpExcel(argFileName)
'  MsgBox argFileName

  nCols = GetMaxCols(argFileName)
  'nCols = 26

  If nCols = 0 Then
    WScript.Echo "ファイルが空です：" & argFileName
    Exit Sub
  End If

  If IsEmpty(oXLS) Then
    Set oXLS = CreateObject("Excel.Application")
    oXLS.Visible = True
    oXLS.WindowState = -4137 'xlMaximized
    Set oWSH = CreateObject("WScript.Shell")
    oWSH.AppActivate oXLS.Caption
  End If

  oXLS.Workbooks.Add
  Set oWbk = oXLS.ActiveWorkbook
  Set oSht = oWbk.ActiveSheet
  With oSht.QueryTables.Add("TEXT;" & argFileName, oSht.Range("$A$1"))
    '.CommandType = 0
    '.Name = "sample"
    '.FieldNames = True
    '.RowNumbers = False
    '.FillAdjacentFormulas = False
    '.PreserveFormatting = True
    '.RefreshOnFileOpen = False
    '.RefreshStyle = 1 'xlInsertDeleteCells
    '.RefreshPeriod = 0
    '.TextFilePromptOnRefresh = False
    '.SavePassword = False
    '.SaveData = True
    
    .TextFilePlatform = 932
    .TextFileStartRow = 1
    .TextFileTextQualifier = 1 'xlTextQualifierDoubleQuote
    .TextFileTrailingMinusNumbers = True
    .AdjustColumnWidth = True
    
    .TextFileParseType = 1 'xlDelimited
    .TextFileCommaDelimiter = True
    .TextFileTabDelimiter = True
    .TextFileSemicolonDelimiter = False
    .TextFileSpaceDelimiter = False
    .TextFileConsecutiveDelimiter = False
    '.TextFileOtherDelimiter = ":"

    Redim arCDTs(nCols - 1)
    For i = 0 To ubound(arCDTs)
      arCDTs(i) = 2
    Next
    
    '.TextFileParseType = 2 'xlFixedWidth
    '.TextFileFixedColumnWidths = Array(1, 1, 1)
    
    '.TextFileColumnDataTypes = Array(2, 2, 2)
    .TextFileColumnDataTypes = arCDTs
    
    .Refresh
    .Delete
    
  End With
  oWbk.Saved = True
End Sub

Function GetMaxCols(argFileName)
  '最終行、中間行の取得
  Set oCsv = oFSO.OpenTextFile(argFileName, 8) 'Append
  nLastLine = oCsv.Line
  oCsv.Close
  nHalfLine = nLastLine \ 2

  '最大列数の取得
  Set oCsv = oFSO.OpenTextFile(argFileName)
  If Not oCsv.AtEndOfLine Then
    '先頭行
    nMaxCols = ubound(Split(oCsv.ReadLine,",")) + 1
    '中間行
    For i = 2 To nHalfLine - 1
      oCsv.SkipLine
      n = n + 1
    Next
    If Not oCsv.AtEndOfLine Then
      nTmpCols = ubound(Split(oCsv.ReadLine,",")) + 1
      n = n + 1
      If nMaxCols < nTmpCols Then
        nMaxCols = nTmpCols
      End If
    End If
    '最終行-1
    For i = nHalfLine + 1 To nLastLine - 2
      oCsv.SkipLine
      n = n + 1
    Next
    If Not oCsv.AtEndOfLine Then
      nTmpCols = ubound(Split(oCsv.ReadLine,",")) + 1
      n = n + 1
      If nMaxCols < nTmpCols Then
        nMaxCols = nTmpCols
      End If
    End If
    '最終行
    If Not oCsv.AtEndOfLine Then
      nTmpCols = ubound(Split(oCsv.ReadLine,",")) + 1
      If nMaxCols < nTmpCols Then
        nMaxCols = nTmpCols
      End If
    End If
    'MsgBox nMaxCols
    GetMaxCols = nMaxCols
  Else
    GetMaxCols = 0
  End If
End Function