Excel提取文件信息方法总结
在excel中（xls或者启动宏的工作表）中 alt +f11打开代码窗口
下面是一些常用代码：
1、判断工作表是否存在，不存在则添加工作表
For i = 1 To Sheets.Count
If Sheets(i).Name = "Comparison" Then
k = 1
'MsgBox "此工作表存在"
End If
Next i
If k = 0 Then
'MsgBox "此工作表不存在"
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Comparison"
End If
2、提取plist文件，并按照一列排布在excel中
这里可以用在所有能用txt打开的文件，如lua等，步骤如下：
①录制宏，插入文件plist，断开连接
②录制宏，选择A1，ctrl+shift+→，ctrl+shift+↓，定位条件：空置，删除（单元格右移）
③结合两个宏即达到提取Plist文件的效果（新建一个文件夹放置Plist内容）
Eg：
Sub link_soul()
‘避免表格已存在的情况
For i = 1 To Sheets.Count
If Sheets(i).Name = "Comparison" Then
k = 1
'MsgBox "此工作表存在"
End If
Next i
If k = 0 Then
'MsgBox "此工作表不存在"
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Comparison"
End If
‘把plist内容放入前先清空一下，避免重叠
Sheets("Comparison").Range("a:a").ClearContents
‘录制宏出现的代码
Sheets("Comparison").Select
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & Plist_dress, Destination:=Range("$A$1"))
.Name = Plist_name & ".plist"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 936
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
'这里要注意一下.断开连接，否则改动会保存到plist文件中；断开连接后，改动的数据不会对原文件造成影响
ActiveWorkbook.Connections(Plist_name).Delete
‘把plist内容提取到一列，方便提取信息
Selection.CurrentRegion.Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.Delete Shift:=xlToLeft
End Sub
3、把plist数据存入数组，下一步依次检验是否是需要的数据
Dim arr_Comparison
Dim arr_Num As Long
‘统计一共有多少项
arr_Num=Range(Sheets("Comparison").Range("A1"),Sheets("Comparison").Range("A1").End(xlDown)).Count
‘装入数据
arr_Comparison=Range(Sheets("Comparison").Range("A1"),Sheets("Comparison").Range("A1").End(xlDown))
‘重新定义数组
ReDim Preserve arr_Comparison(1 To arr_Num, 1 To 1)
‘在用完数组之后，记得释放数组内存，否则运行次数多了，文件会崩溃。
‘释放数据是 Earse arr_Comparison
4、用select case 语句逐语句判断是否是自己需要的内容，如果需要，则进入提取数据的流程。这是提前把数据存在数组中的好处之一，可以用变量i进行逐个判断，且不用再次调用单元格，提高运行速度。
Eg：
Select Case arr_Comparison(i, 1)
'关卡序号，不得已才用《》，正常应是<>
CaseIs = "《key》LevelID《key》"
‘进入plist文件下一行（下一行是数据）
i = i + 1
‘提取数据
Sheets("Record").Cells(Record_row_num, 1 + 1) = Mid(arr_Comparison(i, 1), 9,Len(arr_Comparison(i, 1)) - 17)
‘重复判断
Case is …
…
End Select
提取数据中以下代码较为有用
Y= Mid(X, a, Len(X) - b)
a、b代表常数；
x代表待提取的字符；
Y代表需要的信息。
Eg:
x= 5000
Y=Mid(x, 9, Len(x) - 17)
‘Y=5000
5、用完之后删除放置plist的表格（下一个重复③至⑤的步骤）
Sub link_soul_delete()
Application.DisplayAlerts = False
Sheets("Comparison").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = ture '避开确定删除文件
End Sub
‘解释：Application.DisplayAlerts是为了规避删除中表格弹出二次确认框。
6、依次按照plist列表顺序提取文件，如果文件不存在，则提示“文件未找到”
Public Record_row_num As Long
Public Plist_name As String, Plist_dress As String
Sub main()
Sheets("Record").Range("2:1000").ClearContents’删除内容
'record 数据表中的行号，将用在Analysis_plist中
Record_row_num = 2
Application.ScreenUpdating = False
Do Until Sheets("Plist_name").Cells(Record_row_num, 1) = ""
'依据列表打开文件
Plist_name = Sheets("Plist_name").Cells(Record_row_num, 1)
Plist_dress = ThisWorkbook.Path & "¥待提取plist文件¥" & Plist_name & ".plist"
On Error GoTo AAA ‘如果报错则跳转AAA语句
'打开plist文件（这些是自己写的子过程）
Call link_soul
Call Analysis_plist
'用完之后干掉文件
Call link_soul_delete
'异常情况中断代码（Record_row_num < 0代表该情况永远不会发生，仅AAA语句可以跳转过来）
If Record_row_num < 0 Then
AAA:
Sheets("Plist_name").Select
'打开屏幕更新（与开头Application.ScreenUpdating = false对称）
Application.ScreenUpdating = True
MsgBox ("在plist文件夹中未找到" & Plist_name)
End If
‘进入下一行，继续判断
Record_row_num = Record_row_num + 1
Loop
Application.ScreenUpdating = ture
End Sub
这里有用的是异常情况中断的处理。
7、有了文件名，提取图片，放置在单元格中。
这个可以用作提取项目的一堆图标到excel表格中。如装备，掉落物，截图等
Sub put_into()
Dim x As Integer
x = 待提取文件名
’ P_look.Cells(1, 1)代表需要放入的单元格；这一步是先提取单元格的尺寸，再把图片尺寸修改成合适的大小
ah = P_look.Cells(1, 1).Height
aw = P_look.Cells(1, 1).Width
al = P_look.Cells(1, 1).Left
ap = P_look.Cells(1, 1).Top
'尚未加入其它处理
P_look.Pictures.Insert(ThisWorkbook.Path & "¥文件名¥" & x & ".jpeg").Select
With Selection
‘看需求处理
.Top = ap + 5
.Left = al + 17.5
.Width = aw * 3
.Height = ah * 12.5
End With
Next
Next
x = 0
ah = 0
aw = 0
at = 0
al = 0
End Sub
8、判断当前文件夹的某文件是否存在
这个是与7相关的，判断它是否存在。
①ThisWorkbook.Path 这个是表示找到当前工作簿的位置，比较有用
②name= ThisWorkbook.Path & xxx
If dir(name)=”” then
Msgbox”当前名称不存在”
Endif
9、提取当前文件夹下的用户名
这个也是与7相关的。
Sub get_name()
i = 1
Name_path = ThisWorkbook.Path & ""
Name_file = Dir(Name_path)
Do While file <> ""
Cells(i, 1) = Name_file
i = i + 1
file = Dir
Loop
End Sub
10、批量更改名称
在7的基础上，A列已经提取好目录下的名称，在B列放入需要修改的名称
则用name方法即可达到这一目的。
Dim OldName, NewName
OldName = "OLDFILE": NewName = "NEWFILE" ' 定义文件名。
Name OldName As NewName ' 更改文件名。
OldName = "C:MYDIROLDFILE": NewName = "C:YOURDIRNEWFILE"
Name OldName As NewName ' 更改文件名，并移动文件。
11、删除图标中的所有形状
Sheet1.drawingobject.delete