EXCEL _VBA(檔案列表)

Sub 檔案列表()


Dim myPath As String

Dim myFileName As String

Dim i As Long

myPath = ThisWorkbook.Path & "\"
myFileName = Dir(myPath, 0)

i = 1

Do While Len(myFileName) > 0



Cells(i, 1) = myFileName

myFileName = Dir()

i = i + 1

Loop

k = 1

For j = 1 To i

If Right(Cells(j, 1), 3) = "xls" Then

Cells(k, 2) = Cells(j, 1)



k = k + 1



End If

Next

Columns(1).Delete



End Sub


Sub 指定檔案()

Dim myFs As FileSearch

Dim myPath As String

Dim myClc As New Collection

Dim i As Long

Set myFs = Application.FileSearch

myPath = ThisWorkbook.Path
With myFs

.NewSearch

.LookIn = myPath

.FileType = msoFileTypeAllFiles

.Filename = "*.xls"

.SearchSubFolders = True

If .Execute(SortBy:=msoSortByFileName) > 0 Then

For i = 1 To .FoundFiles.Count

If .FoundFiles(i) Like myPath & "*" Then

On Error Resume Next

myClc.Add .FoundFiles(i), .FoundFiles(i)

On Error GoTo 0

End If

Next

End If

End With

Set myFs = Nothing
With myClc

If .Count > 0 Then

For i = 1 To .Count


Cells(i, 1) = Right(.Item(i), Len(.Item(i)) - Len(myPath) - 1)

Next

Else


End If

End With

Set myClc = Nothing
End Sub

網頁設計常用工具

測試網頁區
測試網頁載入時間 - webwait.com
網頁按鈕產生器 - http://www.buttonator.com/
CSS 網頁按鈕 : http://www.pagetutor.com/button_designer/index.html
網頁按鈕 : http://dabuttonfactory.com/
網頁配色工具 : http://0to255.com/
網頁配色 : http://www.colorotate.org/

EXCEL VBA 工作表重新命名

以下用於更新工作表2010為2011的命名
Sub 重新命名()


For i = 1 To Sheets.Count

x = Sheets(i).Name

s = Len(x)

x1 = Left(x, 3) & "1" & Right(x, s - 4)

Sheets(i).Name = x1

Next

End Sub