Modification to export json file

This commit is contained in:
Sébastien Lucas 2012-05-29 19:59:21 +02:00
parent ea82f76e75
commit e14b564742
1 changed files with 14 additions and 10 deletions

View File

@ -14,7 +14,7 @@ Sub Export_File(sType, iCol As Integer)
Dim bOut() As Byte
Dim shSheet As Worksheet: Set shSheet = Worksheets(sType)
sFilename = sType & "_" & LCase$(shSheet.Cells(cLanguageCodeRow, iCol).Value) & ".properties"
sFilename = sType & "_" & LCase$(shSheet.Cells(cLanguageCodeRow, iCol).Value) & ".json"
oFile = FreeFile()
sFullPath = Application.ActiveWorkbook.Path & "\" & sFilename
On Error Resume Next
@ -24,44 +24,48 @@ Sub Export_File(sType, iCol As Integer)
On Error GoTo 0
Open sFullPath For Binary Access Write As #oFile
' Output comment on version as first line
sOut = "# " & sFilename & " Generated by calibre2opds localization.xls v" & Worksheets(cConfiguration).Cells(cVersionRow, cVersionCol).Value & vbCrLf
sOut = "{" & vbCrLf
bOut = UnicodeToBytes(Worksheets(cConfiguration).Cells(cOutputFormatRow, cOutputFormatCol), sOut)
Put #oFile, , bOut
iRow = cFirstDataRow
Do
sTemp = shSheet.Cells(iRow, cKeywordCol).Value
sOut = sTemp
sOut = "// " & sTemp
' Print #oFile, sTemp;
If Len(sTemp) = 0 Then
iBlankLines = iBlankLines + 1
Else
iBlankLines = 0
If Not isComment(sTemp) Then
sOut = sTemp & "="
If Not isComment(sTemp) And Not sTemp Like "config*" And Not sTemp Like "gui*" Then
sOut = """" & sTemp & """" & ":"
' Print #oFile, "=";
sTemp = shSheet.Cells(iRow, iCol).Value
If Len(sTemp) > 0 Then
sOut = sOut & sTemp
sOut = sOut & """" & sTemp & ""","
sOut = sOut & vbCrLf
bOut = UnicodeToBytes(Worksheets(cConfiguration).Cells(cOutputFormatRow, cOutputFormatCol), sOut)
Put #oFile, , bOut
' Print #oFile, sTemp;
Else
' If no language specific one supplied then
' output English one as a comment starting with '#EN#'
' (as long this is not the english column with empty value)
If iCol <> cEnglishLangCol Then
sOut = "#EN# " & sOut
sOut = "// EN" & sOut
End If
sOut = sOut & shSheet.Cells(iRow, 3).Value
' Print #oFile, shSheet.Cells(iRow, 3).Value;
End If
End If
End If
sOut = sOut & vbCrLf
bOut = UnicodeToBytes(Worksheets(cConfiguration).Cells(cOutputFormatRow, cOutputFormatCol), sOut)
Put #oFile, , bOut
' Print #oFile, "" ' Force new line
iRow = iRow + 1
Loop Until (iBlankLines > 5)
sOut = """fin"":""fin""" & vbCrLf & "}" & vbCrLf
bOut = UnicodeToBytes(Worksheets(cConfiguration).Cells(cOutputFormatRow, cOutputFormatCol), sOut)
Put #oFile, , bOut
Close #oFile
End Sub