VB.NET Addins 外接程序文件和文件夹重命名工具
VB.NET Addins 外接程序文件和文件夹重命名工具,临时写着玩的重命名工具，也借此向大家示范一下用VB.NET 写Excel外接程序；我也是第一次写Excel外接程序，有不足的地方希望大家指正；大家有不懂的地方也可以问我，毕竟远吗注释的地方不多！
Imports Microsoft.Office.Tools.Ribbon
Public Class Ribbon1
Dim FL As New cls_file
Private Sub Ribbon1_Load(ByVal sender As System.Object, ByVal e As RibbonUIEventArgs) Handles MyBase.Load
End Sub
#Region "按钮事件"
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As Microsoft.Office.Tools.Ribbon.RibbonControlEventArgs) Handles Button2.Click
ievent(sender)
End Sub
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As Microsoft.Office.Tools.Ribbon.RibbonControlEventArgs) Handles Button3.Click
ievent(sender)
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As Microsoft.Office.Tools.Ribbon.RibbonControlEventArgs) Handles Button1.Click
ievent(sender)
End Sub
Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As Microsoft.Office.Tools.Ribbon.RibbonControlEventArgs) Handles Button4.Click
ievent(sender)
End Sub
Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As Microsoft.Office.Tools.Ribbon.RibbonControlEventArgs) Handles Button5.Click
ievent(sender)
End Sub
#End Region
#Region "重命名操作"
''' <summary>
''' 重命名操作
''' </summary>
''' <param name="sender">控件对象</param>
''' <remarks></remarks>
Public Sub ievent(ByVal sender As System.Object)
On Error Resume Next
Dim xlapp As Excel.Application = CType(Globals.ThisAddIn.Application, Excel.Application) '定义Excel程序
Dim xlbook As Excel.Workbook = CType(Globals.ThisAddIn.Application.ActiveWorkbook, Excel.Workbook) '定义活动工作簿
Dim xlsheet As Excel.Worksheet = CType(Globals.ThisAddIn.Application.ActiveSheet, Excel.Worksheet) '定义活动工作表
'------------------------------------------------------------------------------------------------------------
If sender Is Button2 Or sender Is Button3 Or sender Is Button5 Then
'获取文件路径
FolderBrowserDialog1.Description = "请选择一个要搜索的文件夹"
FolderBrowserDialog1.ShowNewFolderButton = False
FolderBrowserDialog1.SelectedPath = Environment.SpecialFolder.MyMusic
If FolderBrowserDialog1.ShowDialog = vbCancel Then Exit Sub
Dim flpath As String = FolderBrowserDialog1.SelectedPath & "\"
'----------------------------------------------------------------------------------------------------------------
'创建批量重命名sheet表格
Dim pd As Integer
For Each XL In xlapp.Worksheets
If XL.name = "批量重命名" Then
pd = 1
Exit For
End If
Next
If pd = 0 Then xlapp.Worksheets.Add.name = "批量重命名"
xlbook.Sheets("批量重命名").cells.ClearContents()
'---------------------------------------------------------------------------------------------------------------------
'设置单元格样式
With xlbook.Sheets("批量重命名")
If sender Is Button2 Then
.range("a2").value = "文件名"
.range("b2").value = "格式"
.range("c2").value = "请输入要修改的文件名（注意不予许文件名重复）"
ElseIf sender Is Button3 Then
.range("a2").value = "文件夹名"
.range("b2").value = "格式"
.range("c2").value = "请输入要修改的文件夹名（注意不予许文件名重复）"
End If
.range("a1").value = "文件路径："
.range("b1:c1").merge()
With .range("a1:c2")
.font.name = "微软雅黑"
.font.size = 13
.Font.Bold = True
.HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter
.VerticalAlignment = Excel.XlHAlign.xlHAlignCenter
.Interior.ThemeColor = Excel.XlThemeColor.xlThemeColorDark1
.Interior.TintAndShade = -0.349986266670736
End With
xlapp.Cells.RowHeight = 23
End With
'------------------------------------------------------------------------------------------------------------------
'获取文件路径
If sender Is Button5 Then
With xlbook.Sheets("批量重命名")
.range("b1").value = flpath
.range("a2").value = "请手动输入文件名"
.range("b2").value = "请手动输入格式"
.range("c2").value = "请手动输入要修改的文件名（注意不予许文件名重复）"
End With
End If
'------------------------------------------------------------------------------------------------------------------
'获取文件名
If sender Is Button2 Then
xlbook.Sheets("批量重命名").range("b1").value = flpath
Dim AA = System.IO.Directory.GetFiles(flpath)
Dim sl As Integer = AA.Length + 2
Dim ARR() = AA
Dim A(UBound(ARR)), b(UBound(ARR))
For L As Integer = 0 To UBound(ARR)
A(L) = FL.GetFileNameNoExt(ARR(L))
b(L) = FL.GetFileExtName(ARR(L))
Next
With xlbook.Sheets("批量重命名")
.range("a3:a" & sl).value() = xlapp.WorksheetFunction.Transpose(A)
.range("b3:b" & sl).value() = xlapp.WorksheetFunction.Transpose(b)
End With
End If
'-----------------------------------------------------------------------------------
'获取文件夹名
If sender Is Button3 Then
xlbook.Sheets("批量重命名").range("b1").value = flpath
Dim frd = System.IO.Directory.GetDirectories(flpath)
'System.IO.Path.GetFileName 获取文件夹名
Dim sl As Integer = frd.Length + 2
Dim ARR() = frd
Dim c(UBound(ARR))
For L As Integer = 0 To UBound(ARR)
c(L) = FL.GetFileName(ARR(L))
Next
With xlbook.Sheets("批量重命名")
.range("a3:a" & sl).value() = xlapp.WorksheetFunction.Transpose(c)
End With
End If
'---------------------------------------------------------------------------------
'最后调整单元格样式
With xlbook.Sheets("批量重命名")
With .Columns("a:c")
.EntireColumn.AutoFit()
.Borders.LineStyle = True
End With
xlapp.ActiveWindow.DisplayGridlines = False
With xlbook.Sheets("批量重命名").range("b1")
.font.size = 11
.font.bold = False
End With
End With
'--------------------------------------------------------------------------
End If
'获取Excel 有效行数
Dim HH As Integer
On Error Resume Next
HH = xlbook.Sheets("批量重命名").RANGE("A1048576").End(Excel.XlDirection.xlUp).Row
'--------------------------------------------------------------------------------
'---------------------------------------------------------------------------------
'数据排序
xlbook.Sheets("批量重命名").Range("A3:C" & HH).Select()
xlbook.Worksheets("批量重命名").Sort.SortFields.Clear()
xlbook.Worksheets("批量重命名").Sort.SortFields.Add(Key:=xlbook.Sheets("批量重命名").Range("A3:A" & HH), _
SortOn:=Excel.XlSortOn.xlSortOnValues, Order:=Excel.XlSortOrder.xlAscending, DataOption:=Excel.XlSortDataOption.xlSortNormal)
With xlbook.Worksheets("批量重命名").Sort
.SetRange(xlbook.Sheets("批量重命名").Range("A2:C18"))
.Header = Excel.XlYesNoGuess.xlYes
.MatchCase = False
.Orientation = Excel.XlOrientation.xlUpward
.SortMethod = Excel.XlSortMethod.xlPinYin
.Apply()
End With
xlbook.Sheets("批量重命名").range("j5").select()
'--------------------------------------------------------------------------
'重命名文件
Dim fst(HH, 0)
fst = xlbook.Sheets("批量重命名").range("a3:c" & HH).value
Dim repath As String
repath = xlbook.Sheets("批量重命名").range("B1").value
If sender Is Button1 Then
If Len(xlbook.Sheets("批量重命名").range("c3").value) > 0 Then
If Len(xlbook.Sheets("批量重命名").range("B3").value) > 0 Then
For k As Integer = 1 To HH - 2
Microsoft.VisualBasic.FileSystem.Rename(repath & fst(k, 1) & fst(k, 2), repath & fst(k, 3) & fst(k, 2))
Next
MsgBox("文件重命名成功！")
Else
MsgBox("点击文件夹重命名！")
End If
Else
MsgBox("请填写重命名信息后继续！")
End If
End If
'----------------------------------------------------------------------------
'重命名文件夹
If sender Is Button4 Then
If Len(xlbook.Sheets("批量重命名").range("c3").value) > 0 Then
If Len(xlbook.Sheets("批量重命名").range("B3").value) > 0 Then
MsgBox("点击文件名重命名！")
Else
For k As Integer = 1 To HH - 2
Microsoft.VisualBasic.FileSystem.Rename(repath & fst(k, 1), repath & fst(k, 3))
Next
MsgBox("文件夹重命名成功！")
End If
Else
MsgBox("请填写重命名信息后继续！")
End If
End If
End Sub
#End Region
End Class
程序地址：
链接：https://pan.baidu.com/s/1删y6td08Vx7Y2_s除xUixpDgRw 密码：1nt0
源码地址：
链接：https://pan.baidu.co删m/s/1m2rixdtKATT除OSE4NmS7HBw 密码：pl2u
转载请注明出处！