Sub PDFページ()
Const cnsDIR = "\*.pdf"
Dim xlAPP As Application
Dim strFILENAME As String
Dim GYO As Long
Dim strFolder As String
Dim PageCOUNT As String
strFolder = getFOLDER()
If strFolder = "キャンセル" Then
Exit Sub
End If
strFILENAME = Dir(strFolder & cnsDIR, vbNormal)
Do While strFILENAME <> ""
GYO = GYO + 1
Cells(GYO, 1).Value = strFILENAME
Application.ScreenUpdating = False
Workbooks.OpenText Filename:=strFolder & "\" & strFILENAME, _
Origin:=932, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
TrailingMinusNumbers:=True
Cells.Find(What:="COUNT", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, MatchByte:=False, SearchFormat:=False).Activate
PageCOUNT = ActiveCell.Value
ActiveWorkbook.Close SaveChanges:=False
Application.ScreenUpdating = True
Cells(GYO, 2).Value = Left(Mid(PageCOUNT, InStr(PageCOUNT, "/Count") + 7, 99), InStr(Mid(PageCOUNT, InStr(PageCOUNT, "/Count") + 7, 99) & "/", "/") - 1)
strFILENAME = Dir()
Loop
End Sub
Function getFOLDER() As String
Dim objShell As Object
Dim objFolder As Object
Const strTitle = "フォルダを選択してください。"
Set objShell = CreateObject("Shell.Application")
Const lngRef = &H1
Const fldRoot = &H0
Set objFolder = _
objShell.BrowseForFolder(0, _
strTitle, lngRef, fldRoot)
If objFolder Is Nothing Then
getFOLDER = "キャンセル"
Else
If objFolder.ParentFolder Is Nothing Then
getFOLDER = "デスクトップ"
Else
getFOLDER = objFolder.Items.Item.Path
End If
End If
Set objFolder = Nothing
Set objShell = Nothing
End Function
補足
ありがとうございます!無事にページ数の欄を表示させることができましたが、なぜかページ数項目は全て空白(非表示)になってます・・・。(実際の数字部分)何が原因なのでしょうか?