Efterlysning: Batchredigering sidfot Excel

[Mikael63]

Kort historik bara:

För rätt länge sedan hade jag en mjukvara som kunde söka och ersätta text i sidfoten/sidhuvudet på många Excelfiler, samtidigt.

För inte fullt lika länge sedan laddade jag hem en demoversion (skarp version men utan licens) av samma mjukvara och använde den med, som jag minns gott resultat.

När jag fick (tvingades få) en ny jobbardator hade jag inte behörighet (behörighetsfrågan är numera löst) att installera samma mjukvara på nytt.

Jag beställde då denna mjukvara "officiellt" via vår IT. Det tog bara någon månad att få den och under tiden hade jag löst "uppgiften" på annat sätt.

För några veckor sedan blev det ett behov av att använda denna mjukvara men den beter sig inte som jag minns det och därför blev det handpåläggning i stället.

Idag åter samma behov och samma handpåläggning...

**

Mjukvaran har det korta och kärnfulla namnet "Excel Find and Replace In Headers and Footers Software" från Sobolsoft.

Eller "från" - det är väl mer en distributör antar jag och kanske därför som de inte svarar på e-post?

https://www.sobolsoft.com/excelreplaceheader/

 

På den sidan finns en video och ca 11 sekunder in i den videon ser man hur gränssnittet ser ut.

Så ser inte programmet ut idag:

 

Där, i mitt program, återfinns "Save Results To This Folder" och det är där problemet finns.

Jag vill att programmet ska spara den redigerade filen i sin ursprungliga mapp, oavsett var. Alltså skriva över befintlig fil.

 

Antingen behövs ett helt annat program eller så, om det ens är möjligt, att kunna skriva något typ %=% eller så för att lura programmet.

Eftersom detta är jobbrelaterat behöver inte programmet vara gratis men det måste finnas en fungerande demo/trial jag kan testa.

 

Uppslag?

 

 

[Monshi]

Fungerar programmet? Byter det ut sidfot/huvudelementet? Är bara problemet att det inte sparar på rätt plats?

Det går säkert att lösa via hemhackat makro i en bok. Öppnar bok för bok, söker igenom, sparar.

 

[Mikael63]

jadå programmet fungerar men det blir ett helsike att flytta in filer till sin rätta plats och dessutom kan det vara samma filnamn, fast i olika kataloger

[Monshi]

Ett makro som löser det är nog inte så svårt att få till. Spelade in lite och se:

With ActiveSheet.PageSetup
        .LeftHeader = "Vänster"
        .CenterHeader = "mitt"
        .RightHeader = "höger"
        .LeftFooter = "vänster fot"
        .CenterFooter = "mitt fot"
        .RightFooter = "höger fot"
End With

Med detta som grund, en filselektor och en loop som går igenom filerna, anropar derivat av det ovan, och sparar dem.

Någon regel för vad som ska bytas ut  och du har nog något som kan fungera.

 

Vill du ha mer kod/hela koden för detta?

Går det bra med makro för den delen?

[Mikael63]

Ja, jag kan köra makro.

Vilka filer som ska inkluderas varierar från gång till gång, jag behöver markera en (i sammanhanget) rot-mapp och sedan ska alla *.xls* i den mappen, och i alla underliggande mappar, sökas igenom efter en sträng, vanligen ett datum som ex. 2019-11-28 som ska bytas till ett annat ex. 2019-12-20

[Monshi]

Okej, alltså peka ut en mapp

Stega igenom hela mappen och alla undermappar.

Öppna varje Excel-fil, leta efter ett givet värde och ersätta med ett annat.

Spara denna fil med samma namn.

Finns en risk att detta kan ett bra tag att göra men kan nog, om enkla böcker, kanske fås ned till någon sekund per bok. Om större böcker tar de ju tid att öppna.

...

...

...

en stund senare en fil klar

Testa den om du vågar.

PÅ EN MINDRE MÄNGD FILER SOM START

Den loopar igenom hela din disk om du vill men det skulle nog ta ett tag.

Kan göra bättre startdialog, som fält du ska fylla i på bladet kanske?

En dialog för att hämta sökväg och sedan en startknapp för själva loopen?

Koden kan krascha och en kan poppa upp dialoger om exempelvis filerna som öppnas innehåller data från andra böcker. De ska gå att dölja vill jag minnas men inte fixat det i denna bok (Application.DisplayAlerts = False fixar det troligen) .

Koden kanske inte den finaste men helt ok.

 

var ett tag sedan jag hackade VBA-kod på detta vis (en timmas arbete att få ihop det)

 

 

Koden (norpat och snott delar från nätet):

Option Explicit
Dim globalSearchFor As String
Dim globalReplacewith As String

Sub SearchReplace(searchFor As String, replaceWith As String, ws As Worksheet)
    With ws.PageSetup
        .LeftHeader = replace(.LeftHeader, searchFor, replaceWith)
        .CenterHeader = replace(.CenterHeader, searchFor, replaceWith)
        .RightHeader = replace(.RightHeader, searchFor, replaceWith)
        .LeftFooter = replace(.LeftFooter, searchFor, replaceWith)
        .CenterFooter = replace(.CenterFooter, searchFor, replaceWith)
        .RightFooter = replace(.RightFooter, searchFor, replaceWith)
    End With
End Sub

Sub LoopWorkbook(wb As Workbook)
    Dim ws As Worksheet
    For Each ws In wb.Worksheets
        SearchReplace globalSearchFor, globalReplacewith, ws
    Next ws
End Sub

Function GetFolder() As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set fldr = Nothing
End Function

Sub StartSub()
    Dim value
    value = InputBox("Sök efter")
    If value = "" Then Exit Sub
    globalSearchFor = value
    value = InputBox("Ersätt med")
    If value = "" Then Exit Sub
    globalReplacewith = value
    Dim folder As String
    folder = GetFolder
    
    If folder = "" Then Exit Sub
    Application.ScreenUpdating = False
    LoopAllSubFolders folder
    Application.ScreenUpdating = True
End Sub

Sub LoopAllSubFolders(ByVal folderPath As String)

Dim filename As String
Dim fullFilePath As String
Dim numFolders As Long
Dim folders() As String
Dim i As Long

If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
filename = Dir(folderPath & "*.*", vbDirectory)

While Len(filename) <> 0
    If Left(filename, 1) <> "." Then
        fullFilePath = folderPath & filename
        If (GetAttr(fullFilePath) And vbDirectory) = vbDirectory Then
            ReDim Preserve folders(0 To numFolders) As String
            folders(numFolders) = fullFilePath
            numFolders = numFolders + 1
        Else
            If isExcelFile(folderPath & filename) Then
                Debug.Print folderPath & filename
                Dim wb As Workbook
                On Error GoTo stepOver
                Set wb = Workbooks.Open(folderPath & filename)
                LoopWorkbook wb
                wb.Close True
stepOver:
            End If
        End If
    End If
    filename = Dir()
Wend

For i = 0 To numFolders - 1
    LoopAllSubFolders folders(i)
Next i
End Sub

Function isExcelFile(filename As String) As Boolean
  isExcelFile = (InStr(1, filename, ".xl") > 0)
End Function

 

HuvudFotUpdate.zip

[Mikael63]

Tusen tack!

Jag körde den på min skarpa mapp (en kopia av) och lät den tugga igenom de 34 (excel)filer som fanns där.

Nu ser jag till att spara denna och avinstallerar "mitt" program.

 

En nyfiken fråga: Fungerar även jokertecken?

Låt säga att jag vill ersätta 2018-??-?? med 2019-12-24.

 

Eller jag kan ju testa men..

[Monshi]

Verkar inte fungera med den replace jag använder.

Då får man nog snarare använda instr(...) för att se om strängen innehåller 2018 och då skriva in det nya datumet.

Logiken i SearchReplace blir lite annorlunda, skulle säga gör det i egen funktion som:

Sub test()
    Dim str As String
    str = "2018-01-01"
    str = partSearch(str, "2018", "2019-01-01")
    Debug.Print str
End Sub

Function partSearch(toSearch As String, searchFor As String, newValue As String) As String
    If InStr(1, toSearch, searchFor) > 0 Then
        partSearch = newValue
    Else
        partSearch = toSearch
    End If

End Function

 

[Mikael63]

På 2019-12-18 på 22:02, skrev Monshi:

Verkar inte fungera med den replace jag använder.

Då får man nog snarare använda instr(...) för att se om strängen innehåller 2018 och då skriva in det nya datumet.

Logiken i SearchReplace blir lite annorlunda, ../..

Har inte kollat mer på detta, det blev liksom julledigt och Windowsdatorn åkte ner i "ryggan" men ledigheten torde bjuda på just ledig tid varför jag då kommer att kolla.

[Mikael63]

Så, nu har jag sparkat liv i Windowsdatorn...

Nu behöver jag guidning..

Ska jag byta ut något i den levererade filen med innehållet från inlägget den 18/12?

 

[Monshi]

Inser när jag skriver ett nytt svar att koden INTE bör testas live. Det ovan fungerar inte som det ska.

Ett anrop som

 str = partSearch("Fakturadatum 2018-01-01", "2018", "2019-01-01")
    

Skulle ge resultatet "2019-01-01". Den byter ut hela strängen, hela fältet, vilket du nog inte vill. Måste ta detta tillbaka och ge dig en ny lösning.

[Monshi]

Och mitt förslag blir nu

Sub test()
    Dim str As String
    str = "bla bla 2018-01-01bla bla"
    str = regExpReplace(str, "2018\-\d\d-\d\d", "2019-01-01")
    Debug.Print str
End Sub

Function regExpReplace(toSearch As String, pattern As String, newValue As String) As String
    Dim objRegEx
    Set objRegEx = CreateObject("vbscript.regexp")
    objRegEx.Global = True
    objRegEx.IgnoreCase = True
    objRegEx.MultiLine = True
    objRegEx.pattern = pattern
    regExpReplace = objRegEx.replace(toSearch, newValue)

End Function

Men då måste nog dialogen skrivas om så att du kan få hjälp med söksträngen...

 

ja, se bifogad bok.

 

 

HuvudFotUpdate.zip

[Mikael63]

Jamen det är ju lysande!!

Fungerar helt perfekt och jag behåller även den förra, att användas när det inte är datum som ska ändras!

Stort tack! 

 

[Monshi]

Kan slå ihop båda lösningarna till en och ett val hur sökningen ska ske

kan ska skapas bättre gui även men jag ska nog säga att det är inte min bästa gren att skapa ett grafiskt gränssnitt.

 

[Mikael63]

Äh, det duger jättefint som det är!

[Mikael63]

Uppdatering!

Upptäckte att detta inte fungerar om arbetsboken med makrot ligger i samma "huvudkatalog" som den som ska genomsökas.

Måste ligga på samma nivå, eller över den som ska genomsökas.

 

 

Edited October 9, 2020 by Mikael63
fattar inte vad jag menade