希望一切都好。
我在許多論壇中搜索以找到解決我所面臨問題的方法。我在下面描述。希望有人能幫助我。我需要以下條件的代碼。首先，代碼檢查檔案夾和子檔案夾。如果不存在則根據單元格值 E9:E1200 創建檔案夾名稱，根據單元格值 I 和 H 創建子檔案夾名稱。如果檔案夾和子檔案夾存在則退出。此外，創建指向該子檔案夾的超鏈接。
我目前正在使用下面的代碼，它創建了相同的子檔案夾。我試圖改變它但失敗了。
Sub DownArrow8_Click()
Dim Path As String
Dim Folder As String
For CheckingCells = 9 To 1200
CheckingValue = Cells(CheckingCells, 5).Value
CheckingValueAdress = Cells(CheckingCells, 5).Address
Path = "E:\2. Bill\" & CheckingValue
Folder = Dir(Path, vbDirectory)
If CheckingValue = vbNullString Then
ElseIf Folder = vbNullString Then
VBA.FileSystem.MkDir (Path)
Range(CheckingValueAdress).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="E:\2. Bill\" & CheckingValue, _
TextToDisplay:=CheckingValue
Else
Range(CheckingValueAdress).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="E:\2. Bill\" & CheckingValue, _
TextToDisplay:=CheckingValue
End If
Next CheckingCells
With Range("e9:e1200").Font
.ColorIndex = x1Automatic
.Underline = xlUnderlineStyleNone
.Name = "Times New Roman"
.Size = 18
End With
End Sub
希望有人幫助將不勝感激。
提前致謝。
uj5u.com熱心網友回復：
如果您嘗試在不存在的檔案夾中創建子檔案夾，則會遇到錯誤。您需要遍歷路徑，并嘗試一個一個地創建每個丟失的檔案夾。這是一個可以執行此操作的函式示例：
Sub DownArrow8_Click()
Dim Path As String
Dim Folder As String
Dim WS As Worksheet
Set WS = ActiveSheet
Dim Row As Range
For Each Row In WS.Range("9:1200").EntireRow.Rows
Dim CheckingCell As Range
Set CheckingCell = Row.Cells(5)
Path = "E:\2. Bill\" & CheckingCell.Value
'Creates the folders and subfolders if they don't exist
CreatePath Path
If Not IsEmpty(CheckingCell.Value) Then
WS.Hyperlinks.Add Anchor:=CheckingCell, Address:=Path, _
TextToDisplay:=CheckingCell.Value
End If
Next
With Range("E9:E1200").Font
.ColorIndex = x1Automatic
.Underline = xlUnderlineStyleNone
.Name = "Times New Roman"
.Size = 18
End With
End Sub
Sub CreatePath(Path As String)
Path = Replace(Path, "/", "\")
Dim c As Long
For i = 0 To UBound(Split(Path, "\"))
c = InStr(c 1, Path, "\")
If c = 0 Then c = Len(Path)
CreateIfNotExist Mid(Path, 1, c)
Next
End Sub
Sub CreateIfNotExist(Path As String)
On Error Resume Next
VBA.FileSystem.MkDir (Path)
On Error GoTo 0
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/ruanti/471034.html
上一篇：在ExcelVBA中查看突出顯示的選定行文本時，如何禁用和啟用條件格式（“洗掉線和紅色文本”）？
下一篇：如果單元格為空，VBA洗掉行