ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 129|回复: 4

AI提供,处理在文件夹中选定的文件的一道示例。

[复制链接]

TA的精华主题

TA的得分主题

发表于 2024-8-30 07:22 | 显示全部楼层 |阅读模式
本帖最后由 ning84 于 2024-8-30 07:23 编辑


image.png




[size=0.2]v文件夹中的选定照片,如何在VBA



在VBA中,你可以使用FileSystemObject来访问文件夹中的文件,并且可以使用SendKeys来模拟键盘操作,以选中图片。以下是一个简单的例子,它会遍历指定文件夹内的所有图片文件,并尝试使用Windows图片查看器打开它们。





























Sub SelectPhotosInWindowsPhotoViewer()
    Dim fso As Object
    Dim folder As Object
    Dim file As Object
    Dim photoApp As String

    ' 设置Windows图片查看器的可执行文件路径
    photoApp = "C:\Program Files\Windows Photo Viewer\PhotoViewer.exe"

    ' 创建FileSystemObject并获取v文件夹
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder("V:\") ' 修改为实际的文件夹路径

    ' 遍历文件夹中的文件
    For Each file In folder.Files
        ' 检查文件是否为图片
        If LCase(fso.GetExtensionName(file.Name)) = "jpg" Or LCase(fso.GetExtensionName(file.Name)) = "png" Then
            ' 使用SendKeys发送键盘命令来选择图片

            ' 这里假设Windows图片查看器已经打开
            ' 注意:这种方法依赖于SendKeys,可能会受到键盘hook的影响
            SendKeys "~" ' SendKeys "~" 模拟 Enter 键,用于确定选择的图片
            Application.Wait (Now + TimeValue("0:00:01")) ' 等待1秒,确保SendKeys被处理
        End If
    Next file
End Sub


请注意,SendKeys 方法依赖于用户界面当前的状态,并且容易受到其他程序中的键盘钩子的影响。此外,由于SendKeys发送的是全局按键,可能会影响到其他当前活动的应用程序。
此代码示例只是一个基础示例,并且假设所有图片都是JPEG或PNG格式。根据你的需求,你可能需要对文件类型的检查和处理进行更多的定制。
提示:AI自动生成,仅供参考






TA的精华主题

TA的得分主题

 楼主| 发表于 2024-8-30 07:56 | 显示全部楼层

希望得到的结果选定的文件

image.jpg

image.jpg


代码运行结果,不是目标需求结果。
  1. Sub SelectPhotosInWindowsPhotoViewer()
  2.     Dim Fso As FileSystemObject
  3.         
  4.     Dim Fso As Object
  5.     Dim folder As Object
  6.     Dim file As Scripting.file
  7.     Dim photoApp As String
  8.    
  9.     ' 设置Windows图片查看器的可执行文件路径
  10.     photoApp = "C:\Program Files\Windows Photo Viewer\PhotoViewer.exe"
  11.    
  12.     ' 创建FileSystemObject并获取v文件夹
  13.     Set Fso = CreateObject("Scripting.FileSystemObject")
  14.     Set folder = Fso.GetFolder("f:\JPG") ' 修改为实际的文件夹路径
  15.    
  16.     ' 遍历文件夹中的文件
  17.     For Each file In folder.Files
  18.         ' 检查文件是否为图片
  19.         If LCase(Fso.GetExtensionName(file.Name)) = "jpg" Then
  20.             ' 使用SendKeys发送键盘命令来选择图片
  21.             ' 这里假设Windows图片查看器已经打开
  22.             ' 注意:这种方法依赖于SendKeys,可能会受到键盘hook的影响
  23.             SendKeys "~"
  24.             ' SendKeys "~" 模拟 Enter 键,用于确定选择的图片
  25.             Application.Wait (Now + TimeValue("0:00:01")) ' 等待1秒,确保SendKeys被处理
  26.             With file
  27.                  Debug.Print .Name, .DateLastModified, .DateCreated, .DateLastAccessed
  28.             End With
  29.         
  30.         End If
  31.     Next file
  32. End Sub
复制代码







JPG.zip

257.43 KB, 下载次数: 2

TA的精华主题

TA的得分主题

发表于 2024-8-30 09:39 | 显示全部楼层
你把与人沟通的过程说一篇,要实现什么效果?

TA的精华主题

TA的得分主题

发表于 2024-8-30 09:57 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
应该是代码打开指定文件夹,手动选择多个图片文件。

TA的精华主题

TA的得分主题

 楼主| 发表于 2024-8-31 15:40 | 显示全部楼层
学习SelectedItems笔记


  1. Sub ReadPhotoInfo()
  2.     Dim Rr, Rrr, Kk, Kkk, Str, sItem
  3.         Rr = 10
  4.         Rrr = Rr
  5.     Dim Sht As Worksheet
  6.     Dim Rng As Range, oRng As Range
  7.         Set Rng = Selection
  8.         Set Sht = Rng.Parent
  9.         With Sht
  10.             .Cells.Clear
  11.             .Cells.Font.Size = 9
  12.         End With
  13.     Dim Fso As Scripting.FileSystemObject
  14.         Set Fso = New Scripting.FileSystemObject
  15.     Dim fDia      As FileDialog
  16.     Dim oFiles As Files, oFile As File
  17.          Set fDia = Application.FileDialog(msoFileDialogFilePicker)
  18.          With fDia
  19.              .Title = ""
  20.              .AllowMultiSelect = True
  21.              .InitialFileName = "F:"
  22.              .Show
  23.             
  24.              For Each sItem In .SelectedItems
  25.                   Set oFile = Fso.GetFile(sItem)
  26.                   If Fso.GetExtensionName(oFile.Path) = "jpg" Then
  27.                        ''Debug.Print oFile.Name, oFile.Path
  28.                        With oFile
  29.                           If InStr(.Name, "Screen") > 0 Then
  30.                               Sht.Cells(Rrr + Kkk, "Aa") = .Path
  31.                               Kkk = Kkk + 1
  32.                           Else
  33.                               Sht.Cells(Rr + Kk, "A") = .DateLastModified
  34.                               Sht.Cells(Rr + Kk, "B") = .Name
  35.                               Sht.Cells(Rr + Kk, "C") = Round(.Size / 1024 ^ 2, 1)
  36.                               Sht.Cells(Rr + Kk, "C").Select
  37.                               Sht.Cells(Rr + Kk, "C").Hyperlinks.Add Anchor:=Selection, Address:=oFile.Path, TextToDisplay:=oFile.Path
  38.                               Sht.Cells(Rr + Kk, "Z") = .Path
  39.                               With Sht
  40.                                    HhMmSs .Cells(Rr, "A"), .Cells(Rr + Kk, "A")
  41.                               End With
  42.                               Kk = Kk + 1
  43.                           End If
  44.                        End With
  45.                   End If
  46.              Next sItem
  47.          End With
  48.          With Sht
  49.               Set oRng = .Cells(Rr, "C").Resize(Kk, 1)
  50.               oRng.Select
  51.               .Cells(1, "F") = "=" & oRng.Address
  52.               .Cells(1, "A") = "=""Count:"" & " & " count(" & oRng.Address & ")"
  53.               .Cells(2, "A") = "=""Sum:"" & " & "  sum(" & oRng.Address & ")"
  54.          End With
  55. End Sub
复制代码
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-18 20:01 , Processed in 0.044436 second(s), 10 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表