Excel:makro pro soubory s určitou příponou v aktuální složce Vyřešeno

[claxon]

Zdravím, mám kód viz níže a potřebuju, ať to udělá pro všechny soubory s určitou příponou (*.txt) v aktuální složce se sešitem (nesmí tam být absolutní adresa) a nemůžu na to přijít.
Prosím poraďte - nutné.
Díky moc.
Jinak toto makro mění hodnotu znaku v pořadí 76 (od začátku souboru) - N - na hodnotu C. Funguje to v případě, že tam zadám absolutní adresu a modifikuju konkrétní soubor. Já potřebuju změnit všechny - a předem nebudu znát jejich názvy.


Sub ZmenaKOD(soubor As String)
Open soubor For Binary Access Read Write As #1
Dim Znak As String * 1
Get #1, 76, Znak
If Znak = "N" Then
Seek #1, 1
Put #1, 76, "C"
End If
Close #1
End Sub

[Reklama]

[navstevnik]

Neuvadis verzi Excelu, takze pouzitelnost i pro Ex 2007, obecna procedura otevirajici postupne soubory v adresari:
použít metodu - Dir - která je zabudovaná v objektovém modelu od Office 97.

Kód: Vybrat vše

' Author : Roy Cox (royUK) - modifikovano'
' Purpose : Open all worksheets in a specific folder' Disclaimer;
' This code is offered as is with no guarantees.
' You may use it in your' projects but please leave this header intact.
'---------------------------------------------------------------------------------------
Sub Open_All_Files()
Dim sFil As String
Dim sPath As String

'adresar kde chcete vyhledavat
sPath = "C:\Documents and Settings\Dokumenty\"
ChDir sPath

'nazev a typ souboru, ktery se bude vyhledavat (pouzity zastupne znaky)
sFil = Dir("*.txt")
'pobezi dokud nebudou vsechny soubory v zadane ceste nalezeny
Do While sFil <> ""

' otevreni nalezenych sesitu viz tvuj kod, otevirany soubor je sFil
Open sFil For Binary Access Read Write As #1

' tvuj kod

'uzavre sesit
Close #1
' nacte dalsi soubor
sFil = Dir
Loop ' konec cyklu Do

End Sub

nebo pouzit Windows Scripting Host - WSH - jak doporucuje Microsft (neni upraveno pro tve pouziti)

Kód: Vybrat vše

Sub FilisearchWitFSO()

Dim objFSO As Object, objDir As Object
Dim aItem As Variant
Dim strPath As String, strFileName As String

' posklada retez pro porovnani jmen souboru
strFileName = "*.xl*"
strPath = "C:\Documents and Settings\Dokumenty\"

' vytvori WSH odkaz
Set objFSO = CreateObject("scripting.filesystemobject")
' do promenne ulozi vsechny soubory, ktere najde v zadane ceste
Set objDir = objFSO.GetFolder(strPath)

' pokud nic nenajde, zobrazi hlasku
If objDir.Files.Count > 0 Then
' prochazi vsechny soubory ktere nasel
For Each aItem In objDir.Files
' hleda pouze soubor, ktery odpovida hledanemu vyrazu
If UCase(aItem.Name) Like UCase(strFileName) Then
MsgBox Prompt:="Cesta k souboru " & vbCrLf & aItem.Path, _
Title:="Hledaný soubor - " & strFileName, _
Buttons:=vbInformation

End If
Next
Else ' nebyl nalezen zadny soubor
MsgBox Prompt:="Nebyl nalezen žádny soubor, který odpovída zadanému názvu", _
Title:="Zadaný název - " & strFileName, _
Buttons:=vbInformation
End If

Set objDir = Nothing: Set objFSO = Nothing: Set aItem = Nothing
End Sub

pro adresar s aktivnim sesitem ziskas cestu: Application.ThisWorkbook.Path

[claxon]

Tak nakonec jsem to vložil do funkce a tu funkci uprostřed mého makra zavolal - potřebuju aby to jelo hlavně v 2003, ale již je to vyřešeno.
I tak moc díky..