Hejsan.. Sitter och funderar på ett projekt

säg att jag har en mapp som jag jobbar i och där skapas mycket tempfiler..
jag vill flytta alla filer med endelsen *.jpg och *.bmp till en annan mapp men allt annat vill jag radera i arbetsmappen och undermappar..

är detta möjligt och skulle någon ha någon ide hur jag löser detta problem..

gärna något enkelt ex 2st knappar..

Lägg nedanstående kod i en modul

<code>
Option Explicit

'***FileFinding API***'
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Const MAX_PATH = 260
Const MAXDWORD = &HFFFF
Const INVALID_HANDLE_VALUE = -1
Const FILE_ATTRIBUTE_DIRECTORY = &H10

Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Private cnt As Long

Private Function StripNulls(OriginalStr As String) As String
If (InStr(OriginalStr, Chr(0)) > 0) Then
OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
End If
StripNulls = OriginalStr
End Function

Public Sub MoveFiles(WorkingPath As String, MovingPath As String)
Dim FileName As String, Cont As Integer, hSearch As Long
Dim WFD As WIN32_FIND_DATA

If Right(WorkingPath, 1) <> "\" Then WorkingPath = WorkingPath & "\"
If Right(MovingPath, 1) <> "\" Then MovingPath = MovingPath & "\"

hSearch = FindFirstFile(WorkingPath & "*", WFD)
Cont = True
If hSearch <> INVALID_HANDLE_VALUE Then
Do While Cont
FileName = StripNulls(WFD.cFileName)
If InStrRev(LCase(FileName), ".jpg", -1) Or InStrRev(LCase(FileName), ".bmp", -1) Then
Name WorkingPath & FileName As MovingPath & FileName
Else
If (FileName <> ".") And (FileName <> "..") Then
If Not GetFileAttributes(WorkingPath & FileName) And FILE_ATTRIBUTE_DIRECTORY Then
Kill WorkingPath & FileName
End If
End If

End If
Cont = FindNextFile(hSearch, WFD)
DoEvents
Loop
Cont = FindClose(hSearch)
End If

End Sub

</code>

Hoppas detta var vad du efterfrågade
Knoton

det var intressant kod...
men enklaste måste ändå att köra detta som ett doskomando
ex nedan

test.bat
<code>
d:
cd test
move *.txt "c:\unzipped"
del *.*
cd test2
del *.*
</code>

men hur skriver man doscomandon ifrån vb

Ska du köra dos-kommandon från vb så använder du shell. Tycker jag iaf.


Så här:

Skapa din fil, som vilken annan textfil som helst, med vb, skriv dina kommandorader i filen som strängar, döp den till "nått.cmd"

sen:

<code>

dim x '(vet inte om jag ska dimma som nått här, vet nog nånannan)

x=shell("sökväg till cmd-fil som sträng")

</code>

Hoppas du fattar?:)

var inne mer på att kunna lägga comandona i knappar
men ändå ha det änkelt.. men det lutar så ditt allternativ var det bästa
har för närvarande en bat fil men ville föra över den funktonen i vb
med ditt exemplar funkar även bra..

Jag använder mig av detta, tycker det fungerar bra.
Du kan använda en tempfil.cmd som tas bort när du är klar, du kan oxå dölja själva dos-rutan om du sätter ett kommatecken efter strängen (filnamnet)

/B

gör så.. tackar för hjälpen

Men det finns väl mycket, mycket smidigare lösningar än att använda kommandopromptem för det här?

har du något exemplar så är jag mycket tacksam

Det här borde ju vara hur lätt som helst!
Du behöver:
1. en mapp du kollar i
2. en mapp du ska skicka filerna till
3. ett kriterium för vilka filer som ska skickas

Sen är det inte helt klart hur det ska funka. Låt säga att din mapp 1 är C:\Temp\.
Om du har en undermapp X i den (C:\Temp\X\), och det finns bmp-filer där, ska du då kopiera dem också?
I så fall - ska de direkt till mapp 2 eller till en motsvarande undermapp där?

Oavsett blir ju pseudokoden något i stil med:
<code>
Gå igenom alla filer i mappen (+ev. undermappar)
Om filen uppfyller ditt kriterium: kopiera filen
Annars: ta bort filen
Next
</code>
Några problem?

jo det är något sådant..
men det är alltid lätt när man kan det...

jag stälde frågan här för jag inte viste hur man skriver för att få..

<code>
Gå igenom alla filer i mappen '(+ev. undermappar) behövs inte endast filer med *.jpg och bmp i rotmappen
Om filen uppfyller ditt kriterium: kopiera filen ' flytta. 50meg filer blir segt att kopiera
Annars: ta bort filer i eventuella mapp och undermapp ' alla filer utom *.jpg och *.bmp

</code>

Varför göra det så svårt??

<code>
Dim sPath 'Sökväg till källfilerna
Dim dPath 'Sökväg till målmappen
Dim sFIle

sPath = "c:\source\"
dPath = "c:\destination\"

sFIle = Dir(sPath, vbDirectory)
Do While sFIle <> ""
If sFIle <> "." And sFIle <> ".." Then
If Right(UCase(sFIle), 4) = ".BMP" Or Right(UCase(sFIle), 4) = ".JPG" Then
Name sPath & sFIle As dPath & sFIle
Else
Kill sPath & sFIle
End If
End If
sFIle = Dir
Loop
</code>

Hej Budda exakt min lösning, men orkar inte mer,har skrivit detta 10 tal ggr..

Dom skall krångla till det så ända in i helv.......

Ha det i Svedala

tack Budda
det var precis så jag ville ha...

men det inehåller bara ett litet fel
om det är en undermapp i mappen han kopierar från så blir det fel
i följande rad

<code>
Kill sPath & sFIle
</code>

löste det..

ladde följande code i en modul

<code>
Dim sPath 'Sökväg till källfilerna
Dim dPath 'Sökväg till målmappen

Dim sFIle
Public Sub mapp1()

sPath = "c:\unzipped\1\"

dPath = "c:\unzipped\2\"

sFIle = Dir(sPath, vbDirectory)
Do While sFIle <> ""
If sFIle <> "." And sFIle <> ".." And sFIle <> "3" Then
If Right(UCase(sFIle), 4) = ".TXT" Or Right(UCase(sFIle), 4) = ".JPG" Then
Name sPath & sFIle As dPath & sFIle
Else

Kill sPath & sFIle
End If
End If
sFIle = Dir
Loop
mapp2
End Sub
Public Sub mapp2()

sPath = "c:\unzipped\1\3\"

dPath = "c:\unzipped\2\"

sFIle = Dir(sPath, vbDirectory)
Do While sFIle <> ""
If sFIle <> "." And sFIle <> ".." Then
If Right(UCase(sFIle), 4) = ".TXT" Or Right(UCase(sFIle), 4) = ".JPG" Then
Name sPath & sFIle As dPath & sFIle
Else

Kill sPath & sFIle
End If
End If
sFIle = Dir
Loop
End Sub

</code>

Kanske inte rätt men det funkar så som jag vill ha det... :-)
Tackar alla som hjälpt