将excel导出到csv UTF8的工作VBA [英] A Working VBA that exports excel to csv UTF8

问题描述

这个话题已经得出结论：我是一个初学者，我可以做到这一点 - 如果你需要调整简单的东西，你可能想要阅读这里所说的一切...

This topic has concluded: I'm a total beginner and I can work this - if you need to tweak simple stuff you might want to read all thats been said here...

解决方案被复制在这个帖子的底部...

The solution is copied at the bottom of this post...

原始任务：
这是更好的excel到CSV UTF8解决方案我能够找到。大多数人想要安装插件或者不必要地使进程复杂化。而且还有很多。

Original Task: This is one of the better excel to CSV in UTF8 solutions i was able to find out there. Most either want to install plugins or needlessly complicate the process. And there are many of them.

一个问题已经解决了。 （如何导出使用中的行而不是预定义的数字）

One issue was already solved. (how to export rows in use instead of pre-defined number)

剩下的是调整某些东西。

What remains is to tweak some stuff.

Case Excel
A1=Cat, B1=Dog
A2=empty B2=Empty
A3=Mouse B3=Bird

当前脚本导出

猫，狗

鼠标，鸟

需要的是

"Cat","Dog"
,
"Mouse","Bird"

代码：

Public Sub WriteCSV()
Set wkb = ActiveSheet
Dim fileName As String
Dim MaxCols As Integer
fileName = Application.GetSaveAsFilename("", "CSV File (*.csv), *.csv")

If fileName = "False" Then
End
End If

On Error GoTo eh
Const adTypeText = 2
Const adSaveCreateOverWrite = 2

Dim BinaryStream
Set BinaryStream = CreateObject("ADODB.Stream")
BinaryStream.Charset = "UTF-8"
BinaryStream.Type = adTypeText
BinaryStream.Open

For r = 1 To 2444
s = ""
C = 1
While Not IsEmpty(wkb.Cells(r, C).Value)
s = s & wkb.Cells(r, C).Value & ","
C = C + 1
Wend

If Len(s) > 0 Then
s = Left(s, Len(s) - 1)
End If
BinaryStream.WriteText s, 1

Next r

BinaryStream.SaveToFile fileName, adSaveCreateOverWrite
BinaryStream.Close

MsgBox "CSV generated successfully"

eh:

End Sub

解决方案：
（注意，您可以预先定义通过用数字替换wkb.UsedRange.Rows.Count与列相同的行，并且需要进行其他微小的调整。）
如果要在fileName = Application之后将预定义的文件路径放入空引号中.GetSaveAsFilename（

SOLUTION: (Note you can pre define the number of rows by replacing wkb.UsedRange.Rows.Count with a number - same with columns, and do other minor adjustments should you need to.) If you want a pre defined file path put in the empty quotes after fileName = Application.GetSaveAsFilename(""

Public Sub WriteCSV()
Set wkb = ActiveSheet
Dim fileName As String
Dim MaxCols As Integer
fileName = Application.GetSaveAsFilename("", "CSV File (*.csv), *.csv")

If fileName = "False" Then
End
End If

Const adTypeText = 2
Const adSaveCreateOverWrite = 2

Dim BinaryStream
Set BinaryStream = CreateObject("ADODB.Stream")
BinaryStream.Charset = "UTF-8"
BinaryStream.Type = adTypeText
BinaryStream.Open

For r = 1 To wkb.UsedRange.Rows.Count
    S = ""
    sep = ""

    For c = 1 To wkb.UsedRange.Columns.Count
        S = S + sep
        sep = ","
        If Not IsEmpty(wkb.Cells(r, c).Value) Then
            S = S & """" & wkb.Cells(r, c).Value & """"
        End If
    Next

    BinaryStream.WriteText S, 1

Next r

BinaryStream.SaveToFile fileName, adSaveCreateOverWrite
BinaryStream.Close

MsgBox "CSV generated successfully"

eh:

End Sub

推荐答案

使用：

For r = 1 To wkb.UsedRange.Rows.Count

更新

使用它来删除输出中的逗号。 （见评论）

Use this to remove the trailing commas in your output. (see comments)

If Len(s) > 0 Then
    s = Left(s, Len(s) - 1)
End If
BinaryStream.WriteText s, 1

更新2

我希望这将按照您的期望工作。我改变了逗号的添加方式，并添加了一个变量 sep （separator）。也许你想在函数头中声明它。如果您有一个固定的行数，并且您知道该计数，您可以替换 wkb.UsedRange.Columns.Count 表达式。当你看到里面的引号时，你必须引用一个引用什么使4个引号全部（我不知道这句话是否有意义）： - ）

I hope this will work as you expect. I changed the way the commas are added and added a the variable sep (separator) for that. Maybe you want to declare it in function header. If you have a fixed count of row and you know the count you can replace the wkb.UsedRange.Columns.Count expression. As you see inside quotes you have to quote a quote what makes 4 quotes alltogether (I don't know if this sentence makes sense.) :-)

For r = 1 To wkb.UsedRange.Rows.Count
    s = ""
    sep = ""

    For c = 1 To wkb.UsedRange.Columns.Count
        s = s + sep
        sep = ","
        If Not IsEmpty(wkb.Cells(r, c).Value) Then
            s = s & """" & wkb.Cells(r, c).Value & """"
        End If
    Next

    BinaryStream.WriteText s, 1
Next r

当你终于做到了，深呼吸。

And take a deep breath when you finally did it.

这篇关于将excel导出到csv UTF8的工作VBA的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！