码迷,mamicode.com
首页 > 其他好文 > 详细

Excel格式转化工具

时间:2018-08-19 18:27:01      阅读:167      评论:0      收藏:0      [点我收藏+]

标签:htm   rem   tin   upd   ext2   code   Fix   pen   while   

背景

最近做项目,业务有几百个Excel文件需要上传到系统,由于是薪酬数据内容保密,原始文件不能提供,给了Excel 2007格式的测试数据。

用java代码解析Excel 2007格式,开发完成之后进入UAT,客户测试时说原始文件格式是Excel 2003版本的,给的文件是转化之后的,无奈之下

重新开发Excel 2003版本解析,代码写完交付UAT测试,发现异常,排查原因Excel 2003的原始数据竟然是html格式的文本文件,

实在不想再写java代码去解析html格式的Excel 2003了,因此用VB做了这个小工具,实现文件格式批量转化。

工具和源代码下载地址

 https://pan.baidu.com/s/16346pcwKXX3oRXA0GtcWlQ

页面

 技术分享图片

 

 

 代码

Rem  加载目标文件格式
Private Sub Form_Load()
TypeList.List(0) = "Excel 2003"
TypeList.List(1) = "Excel 2007"
End Sub


Rem  格式转换过程
Private Sub Convert_Click()

Rem 定义变量:源文件夹路径、目标文件夹路径、目标文件格式、目标文件名后缀
Dim SourceDir$, TargetDir$, ExcelTypeIn$, suffix$

Rem 判断源文件夹路径是否存在
SourceDir = Text1.Text
If Dir(SourceDir, vbDirectory) = "." Then
MsgBox "源文件夹路径不能为空!"
Exit Sub
ElseIf Dir(SourceDir, vbDirectory) = "" Then
MsgBox "源文件夹路径" & SourceDir & "不存在!"
Exit Sub
End If
SourceDir = SourceDir & "\"

Rem 判断目标文件夹路径是否存在
TargetDir = Text2.Text
If Dir(TargetDir, vbDirectory) = "." Then
MsgBox "目标文件夹路径不能为空!"
Exit Sub
ElseIf Dir(TargetDir, vbDirectory) = "" Then
MsgBox "目标文件夹路径" & TargetDir & "不存在!"
Exit Sub
End If
TargetDir = TargetDir & "\"

Rem 判断源文件夹路径和目标文件夹路径是否相等
If SourceDir = TargetDir Then
MsgBox "源文件夹路径和目标文件夹路径不能相等!"
Exit Sub
End If

Rem 判断目标文件的格式
ExcelTypeIn = Val(TypeList.ListIndex)
If ExcelTypeIn = "0" Then
suffix = ".xls"
ElseIf ExcelTypeIn = "1" Then
suffix = ".xlsx"
Else
MsgBox "请选择目标文件格式!"
Exit Sub
End If

Rem 当前系统安装什么Excel就获得相应的excel.application
Dim ExApp As Object
Set ExApp = CreateObject("excel.application")
ExApp.Application.ScreenUpdating = False

Dim sourceFile$, targetFile$
sourceFile = Dir(SourceDir & "*.xls")
Do While sourceFile <> ""
targetFile = Left(sourceFile, InStr(sourceFile, ".") - 1) & suffix  目标文件名称

Rem  --------------------------具体转化过程开始----------------------------
ExApp.Workbooks.Open (SourceDir & sourceFile)
ExApp.Application.DisplayAlerts = False
If ExcelTypeIn = "0" Then
ExApp.ActiveWorkbook.SaveAs TargetDir & targetFile, xlExcel8     转换为2003格式
ElseIf ExcelTypeIn = "1" Then
ExApp.ActiveWorkbook.SaveAs TargetDir & targetFile, 51         转换为2007格式
End If
ExApp.Application.DisplayAlerts = True
ExApp.ActiveWorkbook.Close True
Rem  --------------------------具体转化过程结束----------------------------

sourceFile = Dir   获得文件夹中的下一个文件
Loop
ExApp.Application.ScreenUpdating = False
MsgBox "文件夹内的所有Excel文件格式转换完毕!"
End Sub


Rem 结束按钮的事件程序
Private Sub CloseCmd_Click()
End
End Sub
 

 

Excel格式转化工具

标签:htm   rem   tin   upd   ext2   code   Fix   pen   while   

原文地址:https://www.cnblogs.com/walixiansheng/p/9501999.html

(0)
(0)
   
举报
评论 一句话评论(0
登录后才能评论!
© 2014 mamicode.com 版权所有  联系我们:gaon5@hotmail.com
迷上了代码!