1.用VBA出力大文件时的技巧
Execl中的大量行内容经过一些处理后出力到文件时,一件一件写入虽然可以,但影响性能。
可以通过分批写入文件的方法。
Sub outBigData()
Dim content As String
Dim fileName As String;
fileName = "C:\work\test.txt"
Dim i As Integer
i = 1
while ActiveSteet.Cells(i,4).Value<>""
'逻辑处理循环组装出力内容
content = content & Chr(34) & "aaaaaaaaa" & Chr(34)'双引号
content = content & vbLf '换行符
IF i>=200 and i mod 200=0 Then ‘每200行出力一次
whiteFile fileName, content
content = ""
End If
i=i+1
Loop
If Not IsEmpty(content) Then
whiteFile fileName, content
End If
End Sub
Sub whiteFile(Byval fileName As String, ByVal content As String)
Open fileName for Append As #1
Print #1, content; '注意这里的分号是提示不要自动换行的意思,不用分号就会每次输出文件就多一行空行
Close
End Sub
2.VBA出力的文件是Unicode类型转换成UTF8格式
Sub convertFileUTF8(ByVal inputFile as String, ByVal outPutFile As String)
Dim writeStream As Object
Dim fBytes() As Byte
Dim uniString As String
Dim freeNum as Integer
freeNum = FreeFile
ReDim fBytes(1 to FileLen(inputFile)) '注意这里是从1到文件长度,从0开始就会在输出的文件里多出力一个空格
Open inputFile for Binary Access Read As #freeNum
Get #freeNum, , fBytes '读取文件到Byte数组
Close #freeNum
uniString= StrConv(fBytes,vbUnicode)
Set writeStream = CreateObject("ADODB.Stream")
With writeStream
.Type= 1
.Mode = 3
.Charset = "utf-8"
.Open
.writeText uniString
.SaveToFile outPutFile, 2
.Flush
.Close
End With
Set writeStream = Nothing
End Sub
3.VBA中带有Bom的UTF8文件转换成不带Bom的UTF8文件
Sub removBom(ByVal getPath As String, ByVal putPath As String)
Dim getFileNum As Integer, putFileNum As Integer
Dim fBytes() As Byte
Set fos = CreateObject("Scripting.FileSystemObject")
If fos.FileExists(putPath) Then
Kill putPath'如果转换后文件已经存在就先删除掉
End If
getFileNum =1
putFileNum =2
Open getPath for Binary As #getFileNum
Open putPath for Binary As #putFileNum
ReDim fBytes(1 to LOF(getFileNum)-3) '这里不是从0开始是从1开始的不然转换后文件会多一个空格,-3是因为BOM占3字节
Seek #getFileNum, 4 '跳过文件开头的BOM的3个字节
Get #getFileNum, ,fBytes
Put #putFileNum , ,fBytes
Close #getFileNum
Close #putFileNum
End Sub
VBA写出一个不带BOM头的UTF8文件的另一种写法
Dim myStream As ADODB.Stream
Set mySteam = new ADODB.Stream
myStream.Type = adTypeText
myStream.Charset = “UTF-8”
myStream.Open
for i = 0 to 1000
myStream.WriteText "这是一个测试数据", adWritedLine
Next
Dim byteData() as Byte
myStream.Position=0‘这里是为了把位置跳到内容前面
myStream.Type=adTypeBinary’2进制
myStream.Position=3 '这里是为了跳过前3byte也就是Bom
byteData = myStream.Read
myStream.Close
myStream.Open
myStream.Write byteData
myStream.SaveToFile filePath, adSaveCreateOverWrite
删除所有链接
Sub delete_name_and_style()
Dim M()
J=ActiveWorkBook.Styles.count
Redim M(J)
For i = 1 to J
M(i) = ActiveWorkbook.Styles(i).Name
Next
for i to J
If Instr("Hyperlink,Normal,Followed Hyperlink", M(i))=0 Then
ActiveWorkbook.Styles(M(i)).Delete
End If
Next
End Sub
网友评论