投稿‎ > ‎

改行コード、エンコードを検出

posted Aug 20, 2018, 6:21 PM by Zhang Wenxu

Public Sub getFileEncode2()
    Dim cmd As String
    Dim ret As String
    Dim cel As Range
    Dim filename As String
    Dim fileContent As String
   
    For Each cel In Selection
        If cel.EntireRow.Hidden Then GoTo NEXT_ROW
        ret = ""
        filename = "C:\source" & cel.Value
        cmd = """""C:\tools\nkf.exe"""" -g " & filename
       
        ret = runCmd(cmd)
       
        Cells(cel.row, "M").Value = Replace(Replace(Replace(Replace(ret, Chr(10), ""), Chr(13), ""), "-", ""), "ASCII", "SJIS")
       
        If "BINARY" <> Cells(cel.row, "M").Value Then
            fileContent = readFileBinary(filename)
            If InStr(fileContent, Chr(13) & Chr(10)) > 0 Then
                Cells.Cells(cel.row, "N").Value = "CRLF"
            Else
                Cells.Cells(cel.row, "N").Value = "LF"
            End If
        Else
            Cells.Cells(cel.row, "N").Value = "-"
        End If
       
NEXT_ROW:
    Next
End Sub

Public Function runCmd(strCmd As String) As String
    Dim fso As New FileSystemObject

    Dim tempFile As String

    Dim wsh As New WshShell

    Dim waitOnReturn As Boolean

    Dim windowStyle As Integer
    Dim oFile As Variant
   
    tempFile = fso.GetSpecialFolder(TemporaryFolder) & "\" & Replace(fso.GetTempName(), ".tmp", ".txt")

    strCmd = "cmd /c " & strCmd & " > " & tempFile & " 2>&1"

    waitOnReturn = True

    windowStyle = 0

    wsh.Run strCmd, windowStyle, waitOnReturn

    On Error Resume Next

    'runCmd = fso.OpenTextFile(tempFile, ForReading, False).ReadAll
    Set oFile = fso.GetFile(tempFile)

    'If IsNull(oFile) Then MsgBox ("File not found: " & strPath): Exit Function
    If IsNull(oFile) Then
        runCmd = "File not found: " & tempFile
        Exit Function
    End If
   
    With oFile.OpenAsTextStream()
        runCmd = .Read(oFile.Size)
        .Close
    End With

End Function

Public Function readFileBinary(filename As String) As String
    Dim fso As New FileSystemObject
    Dim oFile As Variant
    If Not fso.FileExists(filename) Then
        readFileBinary = ""
        Exit Function
    End If
   
    Set oFile = fso.GetFile(filename)

    'If IsNull(oFile) Then MsgBox ("File not found: " & strPath): Exit Function
    If IsNull(oFile) Then
        readFileBinary = "File not found: " & filename
        Exit Function
    End If
   
    With oFile.OpenAsTextStream()
        readFileBinary = .Read(oFile.Size)
        .Close
    End With
End Function

Comments