ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

sheetÂàutf8 TXT °ÝÃD

sheetÂàutf8 TXT °ÝÃD

¦U¦ì¤j­ô¦n¡G
¤p§ÌªºTEST.XLS·QÂà¥X UTF8 TEST.TXT¦ý¬O¤@ª½µLªk§JªA¡A
§Ú·Q¥Î²Ä¤@­Ó¥¨¶°§¹¦¨¤£ª¾¬O§_¥i¦æ¡C TEST.rar (12.79 KB)
lionliu

¥»©«³Ì«á¥Ñ Joforn ©ó 2016-1-15 09:02 ½s¿è

µLªk¤U¸üªþ¥ó¡A¥u¯à«ö¦Û¤vªº·Qªk¼g¤F¡A½Ð°Ñ¦Ò¤U¼Óªº¥N½X¡C
¥@¬É¨º»ò¤j¡A¥i§Ú·Q¥h­þ¡H

TOP

¦^´_ 1# lionliu
¤£¦n·N«ä¡A2#ªº¥N½X¦³¿ù»~¡A©Ò¥H¦b3#­«·sªþ¤W·sªº¥N½X¡C½Ð·s¼W¤@­Ó¼Ò¶ô¡A±N¤U­±ªº¥N½XÖ߶K¨ì·sªº¼Ò¶ô¸Ì¡G
  1. #If VBA7 Then
  2.   Private Declare PtrSafe Function WideCharToMultiByte Lib "kernel32" _
  3.         (ByVal CodePage As Long, ByVal dwFlags As Long, _
  4.         ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As Long, _
  5.         ByVal lpMultiByteStr As LongPtr, ByVal cchMultiByte As Long, _
  6.         Optional ByVal lpDefaultChar As Long = 0, Optional ByVal lpUsedDefaultChar As Long = 0) As Long
  7. #Else
  8.   Private Declare Function WideCharToMultiByte Lib "kernel32" _
  9.         (ByVal CodePage As Long, ByVal dwFlags As Long, _
  10.         ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, _
  11.         ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, _
  12.         Optional ByVal lpDefaultChar As Long = 0, Optional ByVal lpUsedDefaultChar As Long = 0) As Long
  13. #End If

  14. Public Sub TestSave()
  15.   Dim FileName  As Variant
  16.   
  17.   FileName = Application.GetSaveAsFilename(FileFilter:="UTF-8 Text File,*.TXT", FilterIndex:=1)
  18.   If VarType(FileName) = vbString Then
  19.     If Len(Dir(FileName, vbHidden Or vbReadOnly Or vbSystem)) Then
  20.       If MsgBox("¤åÀɤw¦s¦b¡A¬O§_´_¼g¦¹¤åÀÉ¡H", vbYesNo) = vbNo Then Exit Sub
  21.       SetAttr FileName, vbNormal
  22.       Kill FileName
  23.       If Len(Dir(FileName, vbHidden Or vbReadOnly Or vbSystem)) Then
  24.         MsgBox "¿ù»~¡G" & vbCrLf & "µLªk«O¦s¬°«ü©wªº¤å¥ó¦W¡A¤å¥ó³Q¦û¥Î©ÎÅv­­¤£¤¹³\¡C", vbCritical
  25.         Exit Sub
  26.       End If
  27.     End If
  28.     MsgBox "·í«e¤u§@ªí""" & ActiveSheet.Name & """¥t¦s¬°UTF8 Text¤åÀÉ" & IIf(SaveAsUTF8Text(FileName), "¦¨¥\¡I", "¥¢±Ñ¡I"), vbInformation
  29.   End If
  30. End Sub

  31. Public Function SaveAsUTF8Text(ByVal FileName As String) As Boolean
  32.   Dim FileTemp  As String
  33.   Dim wkIndex   As Long
  34.   Dim lFile     As Long
  35.   Dim bytArr()  As Byte
  36.   Dim bytUTF8() As Byte
  37.   Dim WB        As Workbook
  38.   Dim DisplayAlerts As Boolean, ScreenUpdating As Boolean
  39.   
  40.   On Error Resume Next
  41.    
  42.   DisplayAlerts = Application.DisplayAlerts: ScreenUpdating = Application.ScreenUpdating
  43.   Application.DisplayAlerts = False: Application.ScreenUpdating = False
  44.   wkIndex = ActiveSheet.Index
  45.   FileTemp = GetTempFileName(FileName, "*.XLS")
  46.   ThisWorkbook.SaveCopyAs FileTemp
  47.   Set WB = Workbooks.Open(FileTemp)
  48.   If Not (WB Is Nothing) Then
  49.     WB.Sheets(wkIndex).SaveAs FileName:=FileName, FileFormat:=xlUnicodeText
  50.     WB.Close SaveChanges:=False
  51.     Kill FileTemp
  52.     lFile = FileLen(FileName)
  53.     If lFile > 0 Then
  54.       If lFile > 2 Then
  55.         ReDim bytArr(0 To lFile - 3)
  56.         lFile = FreeFile
  57.         Open FileName For Binary As lFile
  58.         Get lFile, 3, bytArr()
  59.         Close lFile
  60.         Kill FileName
  61.         lFile = WideCharToMultiByte(65001, 0, VarPtr(bytArr(0)), (UBound(bytArr) + 1) \ 2, 0, 0)
  62.         ReDim bytUTF8(0 To 2 + IIf(lFile > 0, lFile, 0))
  63.         If lFile > 0 Then WideCharToMultiByte 65001, 0, VarPtr(bytArr(0)), (UBound(bytArr) + 1) \ 2, VarPtr(bytUTF8(3)), lFile
  64.       Else
  65.         ReDim bytUTF8(0 To 2)
  66.       End If
  67.       bytUTF8(0) = &HEF: bytUTF8(1) = &HBB: bytUTF8(2) = &HBF
  68.       lFile = FreeFile
  69.       Open FileName For Binary As lFile
  70.       Put lFile, , bytUTF8()
  71.       Close lFile
  72.       SaveAsUTF8Text = True
  73.     End If
  74.   End If
  75.   Application.DisplayAlerts = DisplayAlerts: Application.ScreenUpdating = ScreenUpdating
  76. End Function

  77. Private Function GetTempFileName(ByVal FileName As String, Optional ByVal FileType As String) As String
  78.   Dim I As Long
  79.   
  80.   If Len(FileType) Then
  81.     I = InStrRev(FileType, ".")
  82.     If I > 0 Then
  83.       If I = Len(FileType) Then
  84.         FileType = ".XLS"
  85.       Else
  86.         FileType = Mid$(FileType, I)
  87.       End If
  88.     Else
  89.       FileType = "." & FileType
  90.     End If
  91.   Else
  92.     FileType = ".XLS"
  93.   End If
  94.   I = InStrRev(FileName, ".")
  95.   If I > 0 Then FileName = Left$(FileName, I - 1)
  96.   I = 1
  97.   Do While Len(Dir(FileName & I & FileType, vbReadOnly Or vbHidden Or vbSystem Or vbDirectory))
  98.     I = I + 1
  99.   Loop
  100.   GetTempFileName = FileName & I & FileType
  101. End Function
½Æ»s¥N½X
¹B¦æ§»"TestSave"±N·|§â·í«eªº¤u§@ªí«O¦s¬°«ü©wªº¤åÀÉ¡C
¥@¬É¨º»ò¤j¡A¥i§Ú·Q¥h­þ¡H

TOP

¦^´_ 1# lionliu
ªþÀɪº test.txt ¡A¨ÌBOM(Byte Order Mark)¨Ó¬Ý
½s½X¬Ounicode (little endian) ¦Ó«D utf-8¡C
ªí¹F¤£²M¡BÃD·N¤£©ú½T¡B¨SªþÀɮ׮榡¡B¨S¦³°Q½×°ÝÃDªººA«×~~~~~~¥H¤W·R²ö¯à§U¡C

TOP

¥»©«³Ì«á¥Ñ lionliu ©ó 2016-1-15 14:26 ½s¿è

ÁÂÁ¨â¦ì¤j­ôªº¨ó§U
§Ú¤w§ä¨ì³B²z¤è¦¡¡AÁÂÁ¡C
¦b¦¹§Ú±N¥¦´£¨Ñ¤j®a°Ñ¦Ò¡G
  1. Sub FileZM(sFile As String, sCode As String, dFile As String, dCode As String)
  2. Dim objStream As Object
  3.     Set objStream = CreateObject("Adodb.Stream")
  4.     With objStream
  5.         .Mode = 3         'adModeReadWrite = 3 ' «ü¥Ü读/写权­­¡C
  6.         .Type = 1         'adTypeBinary = 1
  7.         .Open
  8.         .LoadFromFile sFile   
  9.         .Position = 0
  10.         .Type = 2      
  11.         .Charset = sCode

  12. sCode = .ReadText   
  13.        .Position = 0     
  14.        .SetEOS
  15.        .Type = 2      
  16.        .Charset = dCode   
  17.        .WriteText sCode   
  18.        .SaveToFile dFile, 2
  19.        .Close
  20.       End With
  21. Set objStream = Nothing
  22. End Sub

  23. Sub SAVE_TXT()
  24.     Dim I%, x%, y%, arr, FileName$
  25.     FileName = "D:\TEST\1000724.txt"
  26.     Open FileName For Output As #1
  27.     Do While Sheets(1).Cells(I + 1, "A") <> ""
  28.         Print #1, Sheets(1).Cells(I + 1, "A")
  29.         I = I + 1
  30.     Loop
  31.     Close #1
  32.    §Ú­ì¨Ó²Ä¤@­Ó¥¨¶°©I¥sfileZM³B¸Ì¬J¥i¡C
  33.    Call FileZM(FileName, "big5", FileName, "utf-8")
  34.    
  35. End Sub
½Æ»s¥N½X
¥H¤W¬O§Ú¦b¤j³°ºô¯¸©Ò§ä¨ìªº¸ê®Æ¡A§Ú­×§ï«á´N¯à¨Ï¥Î¤F
¥H¤U¬O§Ú¬Ý¨ìªº¥t¤@ºØ°µªk¤@¨Ö´£¨Ñ¡G¦ý¬O¤£²Å¦X§Úªº»Ý¨D¡C
¥L·|±N©Ò¦³¸ê®Æ¼g¤J¦P¤@¦æ¡A½Ð°Ý¬O§_¦³¤èªk¥i¥HÅý¥L¤@¦C¤@¦æ¡C
¦ý¤å¦r·í¤¤¤£­n¦³ÁôÂ꺧é¦æ²Å¸¹¡C

Sub Day15_4_()
'¦h°ê»y¨¥¤å¦r¼g¤JUTF8®æ¦¡ªº¤å¦rÀÉ
      Sheets(1).Select
      Dim Rng As Object
      Dim strData

      For Each Rng In Range("A1:b9")
          If Rng.Column = 1 Then
              strData = strData & Rng & vbTab
         ElseIf Rng.Column = 2 Then
             strData = strData & Rng & vbCr
         End If
     Next
     Debug.Print strData

     Dim fsT As Object
     Set fsT = CreateObject("ADODB.Stream")
     fsT.Type = 2 '«ü©wÃþ«¬¡AÀx¦s¤å¦r¸ê®Æ¨Ï¥Î2
     fsT.Charset = "UTF-8" '«ü©w¦r¤¸¶°¬°UTF8
     fsT.Open '¶}±Ò»P¼g¤J¤G¶i¦ì¸ê®Æ¨ìª«¥ó
     fsT.WriteText strData
     fsT.SaveToFile "D:\Day15_4_2.txt", 2 '¼g¤J¤G¶i¦ì¸ê®Æ¨ìºÏºÐ
End Sub
¦¹ºØ¼gªk¬O§Úı±o³Ì²«Kªº¡A½Ð°Ý¬O§_¦³¤j­ô¥i¥H«ü¾É­×¥¿¡C
lionliu

TOP

¦^´_ 5# lionliu
3#ªº¥N½X¬Û¤ñ§A§ä¨ìªº¥N½X¦Ó¨¥§ó¦X¾A¡C
·íµM¤F¡A¦pªG§A¤£¦Ò¼{¨t²Î­Ý®e©Ê©M¹B¦æ³t«×ªº¸Ü´N¥Î§A»{¬°¦nªº¥N½X§Y¥i¡C
§A§ä¨ìªº¥N½X©M§ÚÖߥX¨Óªº¥N½X¦b¤j³°ªººô¯¸¤W´X¦~«e¦³¤£¤Ö°Q½×ªº¡A³o¸Ì§Ú´N¤£­«´_¤F¡C
¥@¬É¨º»ò¤j¡A¥i§Ú·Q¥h­þ¡H

TOP

¦^´_ 6# Joforn

ÁÂÁ J¤jªº«ü¾É¡A#3ªº³¡¤À§Ú·|¦A¦n¦nª¦¤@¤U¤å¡C
lionliu

TOP

¦^´_ 6# Joforn
joforn ¤j­ô¦n¡G
§Ú¸Õ¤F§Ú§ä¨ìªº¤èªk¡AÁÙ¦³§Aªº¤èªk¥i¥H²£¥Íutf8¡A¦ý¬O¹ï¤è­n¨D­n¨S¦³BomÀÉ­ºªºutf8¡A
¤£ª¾¤j­ô©Î¨ä¥L¤j¤j¦³µL¨ä¥L¤èªk¡C
lionliu

TOP

¦^´_  Joforn
joforn ¤j­ô¦n¡G
§Ú¸Õ¤F§Ú§ä¨ìªº¤èªk¡AÁÙ¦³§Aªº¤èªk¥i¥H²£¥Íutf8¡A¦ý¬O¹ï¤è­n¨D­n¨S¦³BomÀÉ ...
lionliu µoªí©ó 2016-1-30 08:53

§Ú¸Õ¤F
  1. Sub Day15_4_()
  2. '¦h°ê»y¨¥¤å¦r¼g¤JUTF8®æ¦¡ªº¤å¦rÀÉ
  3.       Sheets(1).Select
  4.       Dim Rng As Object
  5.       Dim strData

  6.       For Each Rng In Range("A1:b9")
  7.           If Rng.Column = 1 Then
  8.               strData = strData & Rng & vbTab
  9.          ElseIf Rng.Column = 2 Then
  10.              strData = strData & Rng & vbCr
  11.          End If
  12.      Next
  13.      Debug.Print strData

  14.      Dim fsT As Object
  15.      Set fsT = CreateObject("ADODB.Stream")
  16.      fsT.Type = 2 '«ü©wÃþ«¬¡AÀx¦s¤å¦r¸ê®Æ¨Ï¥Î2
  17.      fsT.Charset = "UTF-8" '«ü©w¦r¤¸¶°¬°UTF8
  18.      fsT.Open '¶}±Ò»P¼g¤J¤G¶i¦ì¸ê®Æ¨ìª«¥ó
  19.      fsT.WriteText strData
  20.      fsT.SaveToFile "D:\Day15_4_2.txt", 2 '¼g¤J¤G¶i¦ì¸ê®Æ¨ìºÏºÐ
  21. End Sub
½Æ»s¥N½X
³o¤èªk¬OµLbomÀÉ­ºªº¡A¦ý¬O§Ú­n¦p¦ó±N¾ã­Ó¤u§@ªí¨Ì¶¶§Ç¼g¤J¦Ó¤£¬O¦X¦¨¤@¦æ¡A¬O§_¦³¤j­ô¥i¥H«ü¾É¤@¤U¡C
lionliu

TOP

        ÀR«ä¦Û¦b : ¨ü¤HÂI¤ô¤§®¦¡A¶··í´é¬u¥H³ø¡C
ªð¦^¦Cªí ¤W¤@¥DÃD