Advertisement
nicolaslagios

Excel to csv as utf8 encode directly by Nicolas

Sep 16th, 2017
454
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. 'This vba code was written for the article "Excel to csv as utf8 encode directly by Nicolas" (https://www.nicolaslagios.com/2017/09/16/excel-csv-utf8-encode-directly-by-nicolas/)
  2.  
  3. 'Note that this code with the tools works also on UNC (network) paths
  4.  
  5. Sub saveCSVutf8()
  6.  
  7. Application.DisplayAlerts = False
  8.  
  9.         'deletes the old temp xls & csv files from previous conversions
  10.         'do not change this
  11.        Dim aFile As String
  12.         Dim bFile As String
  13.         aFile = ThisWorkbook.Path & "\temp.xls"
  14.         bFile = ThisWorkbook.Path & "\temp_temp.csv"
  15.         If Len(Dir$(aFile)) > 0 Then
  16.           Kill aFile
  17.         End If
  18.         If Len(Dir$(bFile)) > 0 Then
  19.           Kill bFile
  20.         End If
  21.        
  22.         'Save a copy of your xlsx or xlsm or whatever as xls 2003
  23.        With ActiveWorkbook.WebOptions
  24.         .RelyOnCSS = True
  25.         .OrganizeInFolder = True
  26.         .UseLongFileNames = True
  27.         .DownloadComponents = False
  28.         .RelyOnVML = False
  29.         .AllowPNG = True
  30.         .ScreenSize = msoScreenSize1024x768
  31.         .PixelsPerInch = 96
  32.         .Encoding = msoEncodingUTF8
  33.     End With
  34.     With Application.DefaultWebOptions
  35.         .SaveHiddenData = True
  36.         .LoadPictures = True
  37.         .UpdateLinksOnSave = True
  38.         .CheckIfOfficeIsHTMLEditor = True
  39.         .AlwaysSaveInDefaultEncoding = False
  40.         .SaveNewWebPagesAsWebArchives = True
  41.     End With
  42.     ChDir ThisWorkbook.Path & "\"
  43.     ActiveWorkbook.SaveAs FileName:= _
  44.         ThisWorkbook.Path & "\temp.xls" _
  45.         , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
  46.         ReadOnlyRecommended:=False, CreateBackup:=False
  47.    
  48.     're-opens the previous original file
  49.    Workbooks.Open(FileName:= _
  50.         ThisWorkbook.Path & "\YOUR-FILE.xlsm" _ 'CHANGE YOUR-FILE.xlsm WITH WHATEVER THE NAME IS AND THE EXTENSION
  51.        ).RunAutoMacros Which:=xlAutoOpen
  52.  
  53.     'THIS STEP IS IMPORTAND, YOU NEED IT TO DELETE ANY UNNECESSARY SHEETS ON YOUR NEW XLS FILE AND LEAVE ONLY ONE THERE
  54.    'IF YOU WANT TO ACTIVATE THIS STEP JUST, DELETE THE "'" BELOW AND EDIT THE CODE ACCORDING TO YOUR NEEDS
  55.     'IF YOU DONT KNOW HOW TO EDIT THE CODE BELOW JUST RECORD YOUR STEPS IN A MACRO WITH THE MACRO RECORDER AND ADD YOUR CODE BELOW
  56.    'Windows("temp.xls").Activate
  57.    'Sheets(6).Delete 'Delete the last sheet
  58.    'Sheets(5).Delete 'same
  59.    'Sheets(4).Delete 'same
  60.    'Sheets(2).Delete 'Delete the second sheet
  61.    'Sheets(1).Delete 'Delete the first sheet
  62.    'Sheets(1).Name = "temp" 'rename the remaining sheet
  63.    'ActiveWorkbook.Save 'save the document
  64.    
  65.     'activates the original xlsx(m) file
  66.    Windows("YOUR-FILE.xlsm").Activate
  67.    
  68.     'starting the convertion of xls file to utf8 csv by starting the bat converter
  69.    Shell ThisWorkbook.Path & "\convert.bat"
  70.     Application.Wait (Now + TimeValue("0:00:10"))
  71.    
  72.     'replace decimal .0 on csv file
  73.     'IF YOU DONT WANT TO REPLACE DECIMALS JUST DELETE THE BELOW STEPS
  74.    Dim sBuf As String
  75.     Dim sTemp As String
  76.     Dim iFileNum As Integer
  77.     Dim sFileName As String
  78.     sFileName = ThisWorkbook.Path & "\temp_temp.csv" 'Edit as needed
  79.    iFileNum = FreeFile
  80.     Open sFileName For Input As iFileNum
  81.     Do Until EOF(iFileNum)
  82.     Line Input #iFileNum, sBuf
  83.     sTemp = sTemp & sBuf & vbCrLf
  84.     Loop
  85.     Close iFileNum
  86.     sTemp = Replace(sTemp, ".0""", """")
  87.     iFileNum = FreeFile
  88.     Open sFileName For Output As iFileNum
  89.     Print #iFileNum, sTemp
  90.     Close iFileNum
  91.    
  92.     'final opens folder containing your utf8 csv file
  93.    Shell "explorer.exe" & " " & ThisWorkbook.Path & "\", vbNormalFocus
  94.    
  95.     'closes the temporary xls file
  96.    Windows("temp.xls").Close
  97.  
  98. Application.DisplayAlerts = True
  99.  
  100. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement