' 以下代码，可以调用Excel，并自动打开图片文件，插入 Excel中，并为其生成可点击的链接

On Error Resume Next

Function ExtractFileName(FileName)

 ExtractFileName = Right(FileName, Len(FileName) - InStrRev(FileName, "\"))

End Function

MaxWidth = 320

MaxHeight = 240

dim ExcelApp, Book, Sheet, Files, Pict

Set ExcelApp = CreateObject("Excel.Application")

ExcelApp.Visible = True

set Book = ExcelApp.Workbooks.Add

Files = ExcelApp.GetOpenFilename(" 图片文件(*.jpg;*.jpeg;*.bmp;*.png;*.gif),*.jpg;*.jpeg;*.png;*.bmp;*.gif,所有文件,*.*", 1, , , True)

Set Sheet = Book.WorkSheets(1)

Sheet.Cells(1, 1) = "照片"

Sheet.Cells(1, 2) = "说明"

Row = 2

ExcelApp.ScreenUpdating = False

for each file in Files

 Set Pict = Sheet.Pictures.Insert(File)

 W = Pict.Width

 H = Pict.Height

 If W > MaxWidth Then

         W = MaxWidth

         Pict.Width = W

 End If

 If H > MaxHeight Then

         H = MaxHeight

         Pict.Height = H

 End If

 Pict.Top = Sheet.Cells(Row, 1).Top

 Sheet.Rows(Row).RowHeight = H + 13

 Sheet.Hyperlinks.Add Sheet.Cells(Row, 1), File, , , ExtractFileName(File)

 Row = Row + 1

Next

Sheet.Columns("A:A").ColumnWidth = 52.5

ExcelApp.ScreenUpdating = True