VB脚本，用于从范围B上指定名称的本地目录加载对象

我想写一个macros的代码，将从本地目录加载到Excel说明（“C”）的Excel表，文件上的名称应匹配列（“B”）上的名称。 如果任何文件没有find列B中给出的名称，则应该跳过该行加载文件并继续到下一列。 因为我是VB新手，所以在编写时遇到困难。 我试图以某种方式，但我的脚本工作从目录加载文件和加载名称。 请帮忙！！ 谢谢你们，

码：

Sub Insert_OLE_Object() Dim mainWorkBook As Workbook Set mainWorkBook = ActiveWorkbook Set ActiveSheet = example1 Folderpath = "C:\Documents and Settings\my\Desktop\folder1" Set fso = CreateObject("Scripting.FileSystemObject") NoOfFiles = fso.GetFolder(Folderpath).Files.Count Set listfiles = fso.GetFolder(Folderpath).Files For Each fls In listfiles Counter = Counter + 1 Range("B" & Counter).Value = fls.Name strCompFilePath = Folderpath & "\" & Trim(fls.Name) If strCompFilePath <> "" Then Worksheets("Example1").OLEObjects.Add(Filename:=strCompFilePath, Link:=False, DisplayAsIcon:=True, IconIndex:=1, IconLabel:=strCompFilePath, Left:=20, Top:=40, Width:=150, Height:=10).Select Sheets("example1").Activate Sheets("example1").Range("C" & ((Counter - 1) * 3) + 1).Select End If Next End Sub 

Answer 1

试试这个代码：

 Sub Insert_OLE_Object() Dim ws As Worksheet Dim rng As Range, c As Range Dim strCompFilePath As String, Folderpath As String, fullpath As String Dim obj As Object Application.ScreenUpdating = False 'change to suit Set ws = ThisWorkbook.Worksheets("Example1") 'change B1:B5 to suit Set rng = ws.Range("B1:B5") Folderpath = "C:\Documents and Settings\my\Desktop\folder1" For Each c In rng strCompFilePath = Dir(Folderpath & "\" & Trim(c.Value) & ".*") 'if file with this name found, embed it If strCompFilePath <> "" Then fullpath = Folderpath & "\" & strCompFilePath Set obj = ws.OLEObjects.Add(Filename:=fullpath, Link:=False, _ DisplayAsIcon:=True, IconIndex:=1, _ IconLabel:=fullpath) With obj .Left = c.Offset(, 1).Left .Top = c.Offset(, 1).Top .Width = c.Offset(, 1).ColumnWidth .Height = c.Offset(, 1).RowHeight End With End If Next Application.ScreenUpdating = True End Sub