Note: The other languages of the website are Google-translated. Back to English

Hur räknar man sidnumren för Pdf-filer i Excel?

Om det finns flera Pdf-filer i en viss mapp vill du nu visa alla dessa filnamn i ett kalkylblad och få sidnumren för varje fil. Hur kan du hantera detta jobb i Excel snabbt och enkelt?

Räkna sidnumren för Pdf-filer från en mapp i kalkylbladet med VBA-kod


Räkna sidnumren för Pdf-filer från en mapp i kalkylbladet med VBA-kod

Kan vara följande VBA-kod kan hjälpa dig att visa alla Pdf-filnamn och deras sidnummer i ett kalkylblad, gör så här:

1. Öppna ett kalkylblad där du vill hämta Pdf-filer och sidnummer.

2. Håll ner ALT + F11 knapparna och det öppnar Microsoft Visual Basic för applikationer fönster.

3. Klicka Insert > Modulernaoch klistra in följande makro i Modulerna Fönster.

VBA-kod: Lista alla Pdf-filnamn och sidnummer i kalkylbladet:

Sub Test()
    Dim I As Long
    Dim xRg As Range
    Dim xStr As String
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Dim xFileNum As Long
    Dim RegExp As Object
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.pdf", vbDirectory)
        Set xRg = Range("A1")
        Range("A:B").ClearContents
        Range("A1:B1").Font.Bold = True
        xRg = "File Name"
        xRg.Offset(0, 1) = "Pages"
        I = 2
        xStr = ""
        Do While xFileName <> ""
            Cells(I, 1) = xFileName
            Set RegExp = CreateObject("VBscript.RegExp")
            RegExp.Global = True
            RegExp.Pattern = "/Type\s*/Page[^s]"
            xFileNum = FreeFile
            Open (xFdItem & xFileName) For Binary As #xFileNum
                xStr = Space(LOF(xFileNum))
                Get #xFileNum, , xStr
            Close #xFileNum
            Cells(I, 2) = RegExp.Execute(xStr).Count
            I = I + 1
            xFileName = Dir
        Loop
        Columns("A:B").AutoFit
    End If
End Sub

4. Efter att ha klistrat in koden och tryck sedan på F5 nyckel för att köra den här koden och en Bläddra fönstret visas, välj den mapp som innehåller Pdf-filer du vill lista och räkna sidnummer, se skärmdump:

dokumentantal pdf-sidor 1

5. Och klicka sedan på OK -knappen, alla Pdf-filnamn och sidnummer listas i det aktuella kalkylbladet, se skärmdump:

dokumentantal pdf-sidor 2


De bästa Office-produktivitetsverktygen

Kutools för Excel löser de flesta av dina problem och ökar din produktivitet med 80%

  • återanvändning: Sätt snabbt i komplexa formler, diagram och allt som du har använt tidigare; Kryptera celler med lösenord; Skapa e-postlista och skicka e-post ...
  • Super Formula Bar (enkelt redigera flera rader med text och formel); Läslayout (enkelt läsa och redigera ett stort antal celler); Klistra in i filtrerat intervall...
  • Sammanfoga celler / rader / kolumner utan att förlora data; Delat cellinnehåll; Kombinera duplicerade rader / kolumner... Förhindra duplicerade celler; Jämför intervall...
  • Välj Duplicera eller Unikt Rader; Välj tomma rader (alla celler är tomma); Super Find och Fuzzy Find i många arbetsböcker; Slumpmässigt val ...
  • Exakt kopia Flera celler utan att ändra formelreferens; Skapa referenser automatiskt till flera ark; Sätt in kulor, Kryssrutor och mer ...
  • Extrahera text, Lägg till text, ta bort efter position, Ta bort mellanslag; Skapa och skriva ut personsökningstalsatser; Konvertera mellan celler innehåll och kommentarer...
  • Superfilter (spara och tillämpa filterscheman på andra ark); Avancerad sortering efter månad / vecka / dag, frekvens och mer; Specialfilter av fet, kursiv ...
  • Kombinera arbetsböcker och arbetsblad; Sammanfoga tabeller baserat på nyckelkolumner; Dela data i flera ark; Batchkonvertera xls, xlsx och PDF...
  • Mer än 300 kraftfulla funktioner. Stöder Office / Excel 2007-2021 och 365. Stöder alla språk. Enkel implementering i ditt företag eller organisation. Fullständiga funktioner 30 dagars gratis provperiod. 60 dagars pengarna tillbaka-garanti.
kte-flik 201905

Fliken Office ger ett flikgränssnitt till Office och gör ditt arbete mycket enklare

  • Aktivera flikredigering och läsning i Word, Excel, PowerPoint, Publisher, Access, Visio och Project.
  • Öppna och skapa flera dokument i nya flikar i samma fönster, snarare än i nya fönster.
  • Ökar din produktivitet med 50 % och minskar hundratals musklick för dig varje dag!
officetab botten
Sortera kommentarer efter
Kommentarer (71)
Inga betyg än. Bli först med att betygsätta!
Denna kommentar minimerades av moderatoren på webbplatsen
Fungerar utmärkt! Tack så mycket!
Denna kommentar minimerades av moderatoren på webbplatsen
Tack så mycket för att du postade ett sådant informativt meddelande
Denna kommentar minimerades av moderatoren på webbplatsen
Tack så mycket, utmärkt kod till stor hjälp för mig
Denna kommentar minimerades av moderatoren på webbplatsen
Fungerar inte korrekt, för vissa pdf-filer, för vissa pdf-filer visar den 0 och för vissa felaktiga sidnummer
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Fawaz,
Koden fungerar bra i min Excel, vilken Excel-version använder du?
Eller så kan du skicka ditt detaljerade problem eller pdf-filer till min e-post: skyyang@extendoffice. Com.
Denna kommentar minimerades av moderatoren på webbplatsen
Hej skyyang,

Jag har samma problem som Fawaz. Jag använder MS Office Professional Plus 2013.

Tack för hjälpen!

Med vänliga hälsningar
Denna kommentar minimerades av moderatoren på webbplatsen
Samma som händer här samma pdf-sidor återgår till noll, vänligen någon förklara detta
Denna kommentar minimerades av moderatoren på webbplatsen
Hej, Venkatesh G
Koden fungerar bra i min Excel, skicka dina pdf-filer till min e-post: yy@addin99.com.
Så att vi kan kolla var problemet ligger, tack!
Denna kommentar minimerades av moderatoren på webbplatsen
hälsningar


Hay algún problema con el programa, yo estoy usando la version 2019 de Office, y las páginas parece que las va contando de mal las primeras 9 paginas acumuladas me sale cero, en la novena página acumulada me sale 10.

¿Por favor me puedes ayudar con ese inconveniente?

På förhand tack så mycket.

Atte.

Peter
Denna kommentar minimerades av moderatoren på webbplatsen
HELIG! Det här är häftigt! Tack så mycket! Jag är skrivare och har gjort printit.txt och fyllt i för hand! Detta kommer att göra det MYCKET ENKELARE att citera och kontrollera jobb! Tack igen!!!
Denna kommentar minimerades av moderatoren på webbplatsen
Hälsningar

Det finns ett problem med programmet, jag använder version 2019 av Office, och sidorna verkar räkna dåligt de första 9 ackumulerade sidorna får jag noll, på den nionde ackumulerade sidan får jag 10.

Kan du hjälpa mig med det besväret?

Tack så mycket på förhand.

Atte.

Peter
Denna kommentar minimerades av moderatoren på webbplatsen
Koden är bra struktur för hur man gör sånt här men att regexp kommer att ge opålitliga resultat för många pdf-filer. Regexp som söks efter (/Type\s*/Page[^s]), kommer inte att fungera i SÄKRADE pdf-filer (antalet kommer att vara noll). Även pdf-verktyg och versioner varierar i hur de markerar sidor. Det kan vara korrekt om du vet att alla dina pdf-filer skapas med samma struktur (version och verktyg).
Denna kommentar minimerades av moderatoren på webbplatsen
Tack så mycket för ditt svar, jag löste problemet genom att spara filerna som: "Optimerad PDF"
Denna kommentar minimerades av moderatoren på webbplatsen
Håller till 100% med Pedro, jag hade samma problem som Rob där vissa PDF-sidor var fel. Men om du ser till att alla filer sparas som "Optimerad PDF" i mappen kommer alla sidor att bli korrekta. Detta fungerade för mig på över 100 separata PDF-filer. Du kan också massoptimera med Acrobat Pro. Överlag bra kod, fungerade direkt ur lådan om du så vill.
Denna kommentar minimerades av moderatoren på webbplatsen
Vad händer om jag vill gå igenom undermappar också?
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Prashant,
För att få numret på alla PDF-filer från mappar och undermappar, använd koden nedan:

Delprov ()
Dim I As Long
Dim xRg As Range
Dim xStr As String
Dim xFd As FileDialog
Dim xFdItem som variant
Dim xFileName As String
Dim xFileNum As Long
Dim RegExp som objekt
Ställ in xFd = Application.FileDialog(msoFileDialogFolderPicker)
Om xFd.Show = -1 Då
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
Ställ in xRg = Range("A1")
Range("A:B"). ClearContents
Range("A1:B1"). Font.Bold = True
xRg = "Filnamn"
xRg.Offset(0, 1) = "Sidor"
I = 2
Ring SunTest(xFdItem, I)
End If
End Sub

Sub SunTest(xFdItem As Variant, I As Long)
Dim xRg As Range
Dim xStr As String
Dim xFd As FileDialog
Dim xFileName As String
Dim xFileNum As Long
Dim RegExp som objekt
Dim xF som objekt
Dim xSF som objekt
Dim xFso som objekt
xFilnamn = Dir(xFdItem & "*.pdf", vbDirectory)
xStr = ""
Gör medan xFileName <> ""
Cells(I, 1) = xFilnamn
Ange RegExp = CreateObject("VBscript.RegExp")
RegExp.Global = Sant
RegExp.Pattern = "/Typ\s*/Page[^s]"
xFileNum = FreeFile
Öppna (xFdItem & xFileName) för binärt som #xFileNum
xStr = Mellanslag(LOF(xFileNum))
Skaffa #xFileNum, , xStr
Stäng #xFileNum
Cells(I, 2) = RegExp.Execute(xStr).Count
I = I + 1
xFilnamn = Dir
loop
Kolumner("A:B"). Autoanpassa
Ställ in xFso = CreateObject("Scripting.FileSystemObject")
Ställ in xF = xFso.GetFolder(xFdItem)
För varje xSF i xF.SubFolders
Ring SunTest(xSF.Path & "\", I)
Nästa
End Sub

Försök gärna, hoppas det kan hjälpa dig!
Denna kommentar minimerades av moderatoren på webbplatsen
Din undermappskod fungerar bra! tack
Denna kommentar minimerades av moderatoren på webbplatsen
Det här är underbart, tack. Jag skulle också vilja gå igenom undermappar. Var/hur i ovanstående kod lägger jag till dessa ytterligare kommandon? hur skulle det hela se ut?
Denna kommentar minimerades av moderatoren på webbplatsen
Kan du hjälpa mig att också få fram skaparen och måtten på filen?
Denna kommentar minimerades av moderatoren på webbplatsen
Det är verkligen bra. Men namnen på undermappar kommer inte i separata kolumner med PDF-filnamn och sidantal. Kan du hjälpa till med detta?
Denna kommentar minimerades av moderatoren på webbplatsen
Fantastisk!!!
Denna kommentar minimerades av moderatoren på webbplatsen
Tack så mycket.
Denna kommentar minimerades av moderatoren på webbplatsen
Hallå,
Varsågod. Kul att det hjälper. Har du frågor, kontakta oss gärna. Ha en bra dag.
Vänliga hälsningar,
Mandy
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Mandy,
Jag får ett Runtime-fel '5': Ogiltigt proceduranrop eller argument
Debug går till denna rad: xStr = Space(LOF(xFileNum))
Denna kommentar minimerades av moderatoren på webbplatsen
Jag kör men jag får ett felmeddelande och felsökning visar xStr = Space(LOF(xFileNum)) som problemet.
Denna kommentar minimerades av moderatoren på webbplatsen
Tack så mycket.
På samma sätt, kan du räkna och kategorisera A3- och A4-sidor?
Denna kommentar minimerades av moderatoren på webbplatsen
Här är koden jag hittade någonstans på nätet, den är inte lika optimal som din metod:
Explicit alternativ
Public PDFDoc As AcroPDDoc, PDFPage As Object, A3&, A4&

Sub Main ()
Dim fso As FileSystemObject, fld As Folder, fil As File, s$, i&, Arr()
Ställ in fso = New FileSystemObject
Ställ in PDFDoc = New AcroPDDoc
Ange fld = fso.GetFolder(ThisWorkbook.Path)
ReDim Arr(1 till 1000, 1 till 3)
För varje fil I fld.Files
s = fil.namn
Om Right(s, 4) = ".pdf" Då
CountPagesPDF (This Workbook.Path & "\" & s)
i = i + 1
Arr(i, 1) = s
Arr(i, 2) = A3
Arr(i, 3) = A4
End If
Nästa
Range("A2:C" & Cells.Rows.Count). Rensa
Område("A2:C" & (i + 1)) = Arr
Ställ in PDFPage = Ingenting
Ställ in PDFDoc = Ingenting
Ställ in fso = Ingenting
End Sub

Sub CountPagesPDF(FullFileName$)
Dim i&, n&, x, y
A3 = 0
A4 = 0
PDFDoc.Open (FullFileName)
n = PDFDoc.GetNumPages
För i = 0 Till n - 1
Ställ in PDFPage = PDFDoc.AcquirePage(i)
x = PDFPage.GetSize().x
y = PDFPage.GetSize().y
Om x + y > 1500 då A3 = A3 + 1 Annars A4 = A4 + 1
Nästa
PDFDoc.Close
End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
Wov! så mycket tack för att du delar med dig, den här VBA-koden är en mördare!! Det fungerar felfritt med Excel O365
Denna kommentar minimerades av moderatoren på webbplatsen
Wow. undermappar fungerar utmärkt. kan du dela hur man lägger till "filsökväg" och "filstorlek" också?
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Daphne,
För att lösa ditt problem, använd koden nedan, försök, hoppas det kan hjälpa dig!

Delprov ()
Dim I As Long
Dim xRg As Range
Dim xStr As String
Dim xFd As FileDialog
Dim xFdItem som variant
Dim xFileName As String
Dim xFileNum As Long
Dim RegExp som objekt
Ställ in xFd = Application.FileDialog(msoFileDialogFolderPicker)
Om xFd.Show = -1 Då
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
Ställ in xRg = Range("A1")
Range("A:B"). ClearContents
Range("A1:B1"). Font.Bold = True
xRg = "Filnamn"
xRg.Offset(0, 1) = "Sidor"
xRg.Offset(0, 2) = "Sökväg"
xRg.Offset(0, 3) = "Storlek(b)"
I = 2
Ring SunTest(xFdItem, I)
End If
End Sub

Sub SunTest(xFdItem As Variant, I As Long)
Dim xRg As Range
Dim xStr As String
Dim xFd As FileDialog
Dim xFileName As String
Dim xFileNum As Long
Dim RegExp som objekt
Dim xF som objekt
Dim xSF som objekt
Dim xFso som objekt
xFilnamn = Dir(xFdItem & "*.pdf", vbDirectory)
xStr = ""
Gör medan xFileName <> ""
Cells(I, 1) = xFilnamn
Ange RegExp = CreateObject("VBscript.RegExp")
RegExp.Global = Sant
RegExp.Pattern = "/Typ\s*/Page[^s]"
xFileNum = FreeFile
Öppna (xFdItem & xFileName) för binärt som #xFileNum
xStr = Mellanslag(LOF(xFileNum))
Skaffa #xFileNum, , xStr
Stäng #xFileNum
Cells(I, 2) = RegExp.Execute(xStr).Count
Cells(I, 3) = xFdItem & xFileName
Cells(I, 4) = FileLen(xFdItem & xFileName)
I = I + 1
xFilnamn = Dir
loop
Kolumner("A:B"). Autoanpassa
Ställ in xFso = CreateObject("Scripting.FileSystemObject")
Ställ in xF = xFso.GetFolder(xFdItem)
För varje xSF i xF.SubFolders
Ring SunTest(xSF.Path & "\", I)
Nästa
End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
Det här är så bra. Tack!
Denna kommentar minimerades av moderatoren på webbplatsen
Hej skyyang,
Förlåt att jag stöter på ett gammalt inlägg.
Tack för koden ovan, den hjälper mig så mycket!
Skulle du vara snäll nog att dela med dig av hur man lägger till "filens skapandedatum" även där formatet endast är datumet, ingen tid inkluderad, DD/MMM/ÅÅÅÅ?
Oavsett var jag söker så verkar jag inte kunna redigera din kod för att göra detta korrekt själv..

Tack på förhand!

Stråle
Denna kommentar minimerades av moderatoren på webbplatsen
Åh jag förstår, det här är hela koden. Jag försökte lägga till originalet och fick ett felmeddelande. Tack!
Denna kommentar minimerades av moderatoren på webbplatsen
Hallå.

Finns det något sätt att lägga till sidnumret på dokumenten och jag får också ett felmeddelande och detta är meddelandet:
xStr = Mellanslag(LOF(xFileNum))


Tack så mycket.
Denna kommentar minimerades av moderatoren på webbplatsen
Fantastisk kod! Jag kan inte få det att fungera i undermappar. Kan någon hjälpa mig?
Denna kommentar minimerades av moderatoren på webbplatsen
voce conseguiu achar uma maneira de funcionar em subpastas?
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Flavio,
För att få numret på alla PDF-filer från mappar och undermappar, använd koden nedan:

Sub Test()
Dim I As Long
Dim xRg As Range
Dim xStr As String
Dim xFd As FileDialog
Dim xFdItem As Variant
Dim xFileName As String
Dim xFileNum As Long
Dim RegExp As Object
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
If xFd.Show = -1 Then
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
Set xRg = Range("A1")
Range("A:B").ClearContents
Range("A1:B1").Font.Bold = True
xRg = "File Name"
xRg.Offset(0, 1) = "Pages"
I = 2
Call SunTest(xFdItem, I)
End If
End Sub

Sub SunTest(xFdItem As Variant, I As Long)
Dim xRg As Range
Dim xStr As String
Dim xFd As FileDialog
Dim xFileName As String
Dim xFileNum As Long
Dim RegExp As Object
Dim xF As Object
Dim xSF As Object
Dim xFso As Object
xFileName = Dir(xFdItem & "*.pdf", vbDirectory)
xStr = ""
Do While xFileName <> ""
Cells(I, 1) = xFileName
Set RegExp = CreateObject("VBscript.RegExp")
RegExp.Global = True
RegExp.Pattern = "/Type\s*/Page[^s]"
xFileNum = FreeFile
Open (xFdItem & xFileName) For Binary As #xFileNum
xStr = Space(LOF(xFileNum))
Get #xFileNum, , xStr
Close #xFileNum
Cells(I, 2) = RegExp.Execute(xStr).Count
I = I + 1
xFileName = Dir
Loop
Columns("A:B").AutoFit
Set xFso = CreateObject("Scripting.FileSystemObject")
Set xF = xFso.GetFolder(xFdItem)
For Each xSF In xF.SubFolders
Call SunTest(xSF.Path & "\", I)
Next
End Sub


Försök gärna, hoppas det kan hjälpa dig!
Denna kommentar minimerades av moderatoren på webbplatsen
Sim funkar! muito obrigado

Alguns documentos .pdf estao sendo analisados ​​com 0 paginas incorretamente. Saberia me dizer o porque?
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Flavio,
Du kan ladda upp din PDF-fil här, så att vi kan kontrollera problemet.
Tack!
Denna kommentar minimerades av moderatoren på webbplatsen
Opa, super top, consegue adicionar para aparecer o tamanho do arquivo, na terceira coluna ?
Denna kommentar minimerades av moderatoren på webbplatsen
Hej, SrdosPDF
Följande VBA-kod kan göra dig en tjänst, prova den:
Sub Test()
Dim I As Long
Dim xRg As Range
Dim xStr As String
Dim xFd As FileDialog
Dim xFdItem As Variant
Dim xFileName As String
Dim xFileNum As Long
Dim RegExp As Object
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
If xFd.Show = -1 Then
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
Set xRg = Range("A1")
Range("A:B").ClearContents
Range("A1:B1").Font.Bold = True
xRg = "File Name"
xRg.Offset(0, 1) = "Pages"
xRg.Offset(0, 2) = "Size(b)"
I = 2
Call SunTest(xFdItem, I)
End If
End Sub

Sub SunTest(xFdItem As Variant, I As Long)
Dim xRg As Range
Dim xStr As String
Dim xFd As FileDialog
Dim xFileName As String
Dim xFileNum As Long
Dim RegExp As Object
Dim xF As Object
Dim xSF As Object
Dim xFso As Object
xFileName = Dir(xFdItem & "*.pdf", vbDirectory)
xStr = ""
Do While xFileName <> ""
Cells(I, 1) = xFileName
Set RegExp = CreateObject("VBscript.RegExp")
RegExp.Global = True
RegExp.Pattern = "/Type\s*/Page[^s]"
xFileNum = FreeFile
Open (xFdItem & xFileName) For Binary As #xFileNum
xStr = Space(LOF(xFileNum))
Get #xFileNum, , xStr
Close #xFileNum
Cells(I, 2) = RegExp.Execute(xStr).Count
Cells(I, 3) = FileLen(xFdItem & xFileName)
I = I + 1
xFileName = Dir
Loop
Columns("A:B").AutoFit
Set xFso = CreateObject("Scripting.FileSystemObject")
Set xF = xFso.GetFolder(xFdItem)
For Each xSF In xF.SubFolders
Call SunTest(xSF.Path & "\", I)
Next
End Sub

Hoppas detta kan hjälpa dig!
Denna kommentar minimerades av moderatoren på webbplatsen
Tack så mycket
Denna kommentar minimerades av moderatoren på webbplatsen
Hej, det fungerar utmärkt, tack för att du delar detta. En fråga, är det möjligt att lägga till som även räknar microsoft word .doc och .docx filer?
Denna kommentar minimerades av moderatoren på webbplatsen
Hej sroczeto,
För att räkna sidnumret för .doc och .docx samt PDF-filerna, använd följande kod:
Delprov ()
Dim I As Long
Dim xRg As Range
Dim xStr As String
Dim xFd As FileDialog
Dim xFdItem som variant
Dim xFileName As String
Dim xFileNum As Long
Dim RegExp som objekt
Dim xWdApp
Dim xWd
Ställ in xFd = Application.FileDialog(msoFileDialogFolderPicker)
Om xFd.Show = -1 Då
Application.ScreenUpdating = False
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFilnamn = Dir(xFdItem & "*.pdf", vbDirectory)
Ställ in xRg = Range("A1")
Range("A:B"). ClearContents
Range("A1:B1"). Font.Bold = True
xRg = "Filnamn"
xRg.Offset(0, 1) = "Sidor"
I = 2
xStr = ""
Gör medan xFileName <> ""
Cells(I, 1) = xFilnamn
Ange RegExp = CreateObject("VBscript.RegExp")
RegExp.Global = Sant
RegExp.Pattern = "/Typ\s*/Page[^s]"
xFileNum = FreeFile
Öppna (xFdItem & xFileName) för binärt som #xFileNum
xStr = Mellanslag(LOF(xFileNum))
Skaffa #xFileNum, , xStr
Stäng #xFileNum
Cells(I, 2) = RegExp.Execute(xStr).Count
I = I + 1
xFilnamn = Dir
loop
xFilnamn = Dir(xFdItem & "*.docx", vbDirectory)
Ställ in xWdApp = CreateObject("Word.Application")
Gör medan xFileName <> ""
Cells(I, 1) = xFilnamn
xFileNum = FreeFile
Ställ in xWd = GetObject(xFdItem & xFileName)
Celler(I, 2) = xWd.ActiveWindow.Panes(1).Pages.Count
xWd.Stäng Falskt
I = I + 1
xFilnamn = Dir
loop
Kolumner("A:B"). Autoanpassa
End If
Application.ScreenUpdating = True
End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
Tack mate! Det fungerar på pdf och docx, men inte på doc-filer. Och en fråga till, kan du tillägga att detta kommer att räknas i undermappar också?
Denna kommentar minimerades av moderatoren på webbplatsen
Jag har öppnat en pdf-fil vars sökväg och namn nämns i excel-cellens kolumn "C9". Jag vill bara få sista sidnumret i excel vba snälla hjälp mig
Denna kommentar minimerades av moderatoren på webbplatsen
Hej, det här fungerar verkligen bra, tack. Är det möjligt att få sidstorleken på första sidan i en ny kolumn? exempel 8.5 x 11, 11 x 17 osv.
Denna kommentar minimerades av moderatoren på webbplatsen
Hej, det här fungerar riktigt bra tack!, är det möjligt att få sidstorleken för första sidan i PDF-dokumentet?
Denna kommentar minimerades av moderatoren på webbplatsen
Hallå,
Är det möjligt att även få sidornas dimensioner och skaparen av pdf:en i detta makro?
kan någon hjälpa mig med detta?
Denna kommentar minimerades av moderatoren på webbplatsen
finns det ett sätt att inkludera .doc Jag märkte att det fungerar för .docx men inte .doc
Denna kommentar minimerades av moderatoren på webbplatsen
Hej John! För att räkna sidorna i .doc och .docx samt PDF-filerna, använd följande kod: Understatistiksida()
Dim I As Long
Dim xRg As Range
Dim xStr As String
Dim xFd As FileDialog
Dim xFdItem som variant
Dim xFileName As String
Dim xFileNum As Long
Dim RegExp som objekt
Dim xWdApp
Dim xWd
Ställ in xFd = Application.FileDialog(msoFileDialogFolderPicker)
Om xFd.Show = -1 Då
Application.ScreenUpdating = False
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFilnamn = Dir(xFdItem & "*.pdf", vbDirectory)
Ställ in xRg = Range("A1")
Range("A:B"). ClearContents
Range("A1:B1"). Font.Bold = True
xRg = "Filnamn"
xRg.Offset(0, 1) = "Sidor"
I = 2
xStr = ""
Gör medan xFileName <> ""
Cells(I, 1) = xFilnamn
Ange RegExp = CreateObject("VBscript.RegExp")
RegExp.Global = Sant
RegExp.Pattern = "/Typ\s*/Page[^s]"
xFileNum = FreeFile
Öppna (xFdItem & xFileName) för binärt som #xFileNum
xStr = Mellanslag(LOF(xFileNum))
Skaffa #xFileNum, , xStr
Stäng #xFileNum
Cells(I, 2) = RegExp.Execute(xStr).Count
I = I + 1
xFilnamn = Dir
loop
xFilnamn = Dir(xFdItem & "*.docx", vbDirectory)
Ställ in xWdApp = CreateObject("Word.Application")
Gör medan xFileName <> ""
Cells(I, 1) = xFilnamn
xFileNum = FreeFile
Ställ in xWd = GetObject(xFdItem & xFileName)
Celler(I, 2) = xWd.ActiveWindow.Panes(1).Pages.Count
xWd.Stäng Falskt
I = I + 1
xFilnamn = Dir
loop
xFilnamn = Dir(xFdItem & "*.doc", vbDirectory)
Ställ in xWdApp = CreateObject("Word.Application")
Gör medan xFileName <> ""
Cells(I, 1) = xFilnamn
xFileNum = FreeFile
Ställ in xWd = GetObject(xFdItem & xFileName)
Celler(I, 2) = xWd.ActiveWindow.Panes(1).Pages.Count
xWd.Stäng Falskt
I = I + 1
xFilnamn = Dir
loop
Kolumner("A:B"). Autoanpassa
End If
Application.ScreenUpdating = True
Avsluta SubSnälla försök, hoppas det kan hjälpa dig!
Denna kommentar minimerades av moderatoren på webbplatsen
Tack detta hjälper mycket.
Denna kommentar minimerades av moderatoren på webbplatsen
Hej, jag har en mapp med flera undermappar. Hur kan jag ange den överordnade mappen Sökväg utan att manuellt välja den. Sedan också utgången namnet på den underordnade mappen. Tack på förhand 
Denna kommentar minimerades av moderatoren på webbplatsen
HI sorterade jag har redigerat koden bort XFD och satt filpath som xfditem
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Skyyang, Först vill jag tacka dig för det otroliga arbetet du gör, och den tid du tar...Jag letar ett tag efter en VBA-kod :Jag har ett Excel-ark med en lista i kolumn "J" av pdf-, xlsx- och elm-filer som finns i en datarumskatalog (med underkataloger)Filnamn är kompletta med typ X:\Data_Room\Sub_directory_1\file.pdfKoden ska fylla kolumnen "I" med antalet sidor i varje .pdf och .xls-filer (inget behov av andra, celler bör vara tomma) Kan du hjälpa mig?
Denna kommentar minimerades av moderatoren på webbplatsen
Finns det någon chans att detta kan utökas för att hämta ett Bates-nummer från första sidan i varje pdf?
Det finns inga kommentarer här ännu
Ladda fler
Lämna dina kommentarer
Postar som gäst
×
Betygsätt detta inlägg:
0   Tecken
Föreslagna platser

Följ oss

Copyright © 2009 - www.extendoffice.com. | Alla rättigheter förbehållna. Drivs av ExtendOffice. | | Sitemap
Microsoft och Office-logotypen är varumärken eller registrerade varumärken som tillhör Microsoft Corporation i USA och / eller andra länder.
Skyddad av Sectigo SSL