VBScript Fehler Dateien bereits vorhanden?

Ich schreibe gerade an einer art "DesktopCleaner"... das ganze soll erstmal nur auf meinem System funktionieren.

Option Explicit 
Dim objFSO, objFolder, objSubFld, f1, f2, colFiles, pathname, i 
Set objFSO = CreateObject("Scripting.FileSystemObject") 
Set objFolder = objFSO.GetFolder("D:\") 
ChkSubFld objFolder 

Private Sub ChkSubFld(StartFolder) 
ChkFiles StartFolder 
Set objSubFld = StartFolder
For Each f2 in objSubFld 
ChkSubFld f2 
Next 
End Sub 

Private Sub ChkFiles(Start) 
Set colFiles = Start.Files 
For Each f1 in colFiles 
pathname = objFSO.GetAbsolutePathName(f1)
MsgBox pathname
 If Not (pathname = "D:\4.m3u") Or (pathname = "D:\CyberGhost 6.lnk") Or (pathname = "D:\desktop.ini") Or (pathname = "D:\Electrum-LTC.lnk") Or (pathname = "D:\Electrum.lnk") Or (pathname = "D:\Lazarus.lnk") Or (pathname = "D:\Start Tor Browser.lnk") Or (pathname = "D:\TeamSpeak 3 Client.lnk") Then
objFSO.MoveFile pathname, "D:\Alles Desktop\DesktopCleaner"
End If
Next 
End Sub 

objFSO.MoveFile "E:\VBS\DesktopCleaner\data\TranscodedWallpaper", "C:\Users\Ericmc\AppData\Roaming\Microsoft\Windows\Themesr"
MsgBox "Fertig!"

Also der Ablauf soll sein: Lösche alle Dateien auf dem Desktop (D:), ändere das Desktop Hintergrundbild. Der Fehler ist wohl beim ersten objFSO.MoveFile .... ich schaffe es aber nicht ihn zu beheben. Es kommt immer die aussage die Dateien würden bereits existieren?? Obwohl der Ordner DesktopCleaner leer ist. Danke für eure Hilfe.

2 Antworten

Vom Fragesteller als hilfreich ausgezeichnet

regex9

Von gutefrage auf Grund seines Wissens auf einem Fachgebiet ausgezeichneter Nutzer

programmieren

05.03.2017, 22:00

Wirkt sich das NOT in der Abfrage denn auf alle Folgefälle aus bzw. soll dem so sein?

If Not (pathname = "D:\4.m3u") Or (pathname = "D:\CyberGhost 6.lnk") Or (pathname = "D:\desktop.ini") Or (pathname = "D:\Electrum-LTC.lnk") Or (pathname = "D:\Electrum.lnk") Or (pathname = "D:\Lazarus.lnk") Or (pathname = "D:\Start Tor Browser.lnk") Or (pathname = "D:\TeamSpeak 3 Client.lnk") Then

Prinzipiell würde ich da mit einem regulären Ausdruck oder einem

switch

-Statement (SELECT ... CASE) arbeiten.

Des Weiteren solltest du alle versteckten (System-)Dateien bei Windows einmal einblenden lassen und via Debugger den aktuellen Einzelfall prüfen, an dem deine Anwendung da scheitert.

Ansonsten wäre die echte und vollständige Fehlermeldung interessant.

Erri2001

Fragesteller

05.03.2017, 22:09

1. Ja Das Not soll sich auf alle beziehen (wenn nicht das oder das oder das...)

2. Das verstehe ich nicht ganz. Es soll ja etwas geschehen wenn es nicht eine bestimmte Dateiart ist.

3. Keine versteckten Dateien

4. Weiß nicht genau wie man eine VBS Datei debuggt

5 Fehlermeldung:

Skript: E:\VBS\DesktopCleaner\DesktopCleaner.vbs
Zeile: 19
Zeichen: 1
Fehler: Die Datei ist bereits vorhanden
Code: 800A003A
Quelle: Laufzeitfehler in Microsoft VBScript

Erri2001

Fragesteller

05.03.2017, 22:12

@Erri2001

Die Zeile MsgBox pathname hab ich nur zum prüfen reingemacht... das Fenster wird noch angezeigt bevor der Fehler kommt

regex9

05.03.2017, 22:47

@Erri2001

Dann müsstest du das auch für jeden Fall so angeben: IF NOT a OR NOT b OR NOT c ...
Genau. Doch diese Bedingung könntest du so doch verkürzen oder lesbarer gestalten. Bei einem SELECT CASE würde im CASE ELSE dein Code angeführt werden. Sicherlich gäbe es noch andere Alternativen, bspw. das Speichern aller Pfade in einer Liste und die darauffolgende Abfrage, ob der Wert in dieser Liste vorkommt.
Debugging: Es wäre für den Anfang ausreichend für dich zu erfahren, welche Datei er gerade verschieben möchte. Also lasse dir den Pfad ausgeben.
Füge bei dem Zielpfad mal noch einen Backslash an, so, wie es in der Dokumentation auch aufgeführt wird. https://msdn.microsoft.com/de-de/library/2wcf3ba6(v=vs.84).aspx

regex9

06.03.2017, 01:32

@regex9

Nachtrag: OR NOT wäre natürlich auch nicht richtig, sondern wenn nur AND NOT oder eine Gruppierung: NOT (a OR b).

Erri2001

05.03.2017, 21:51

*Lösche alle Dateien ausser desktop.ini usw.

Woher ich das weiß:Studium / Ausbildung – ITA + Programmieren seit dem 14. Lebensjahr

Hallo,

ich benutze folgenden Code in Excel VBA um mir Dateipfad und Dateiname eines Ordners und allen darin enthaltenen Unterordnern aufzulisten.
(Ihr könnt es testen, den Code einfach in ein Modul kopieren, "MainList" ausführen und einen Ordner eurer Wahl auswählen)

Ich habe jetzt das Problem, dass dieser Code alle Dateien überspringt, deren Pfadlänge über 255 Zeichen lang ist. Einige Dateien überschreiten nämlich die 255 Zeichen mit dem angehängten Dateinamen.
Sie liegen aber dennoch ab. Nur liest VBA diese nicht aus. Kann man da was dran machen?

Sub MainList()
'Updateby Extendoffice
Set Folder = Application.FileDialog(msoFileDialogFolderPicker)
If Folder.Show <> -1 Then Exit Sub
xDir = Folder.SelectedItems(1)
Call ListFilesInFolder(xDir, True)
End Sub

Sub ListFilesInFolder(ByVal xFolderName As String, ByVal xIsSubfolders As Boolean)
Dim xFileSystemObject As Object
Dim xFolder As Object
Dim xSubFolder As Object
Dim xFile As Object
Dim rowIndex As Long
Set xFileSystemObject = CreateObject("Scripting.FileSystemObject")
Set xFolder = xFileSystemObject.GetFolder(xFolderName)
rowIndex = Application.ActiveSheet.Range("A65536").End(xlUp).Row + 1
For Each xFile In xFolder.Files
  Application.ActiveSheet.Cells(rowIndex, 1).Formula = xFile.Path
  Application.ActiveSheet.Cells(rowIndex, 2).Formula = xFile.Name
  rowIndex = rowIndex + 1
Next xFile
If xIsSubfolders Then
  For Each xSubFolder In xFolder.SubFolders
    ListFilesInFolder xSubFolder.Path, True
  Next xSubFolder
End If
Set xFile = Nothing
Set xFolder = Nothing
Set xFileSystemObject = Nothing
End Sub

Function GetFileOwner(ByVal xPath As String, ByVal xName As String)
Dim xFolder As Object
Dim xFolderItem As Object
Dim xShell As Object
xName = StrConv(xName, vbUnicode)
xPath = StrConv(xPath, vbUnicode)
Set xShell = CreateObject("Shell.Application")
Set xFolder = xShell.Namespace(StrConv(xPath, vbFromUnicode))
If Not xFolder Is Nothing Then
  Set xFolderItem = xFolder.ParseName(StrConv(xName, vbFromUnicode))
End If
If Not xFolderItem Is Nothing Then
  GetFileOwner = xFolder.GetDetailsOf(xFolderItem, 8)
Else
  GetFileOwner = ""
End If
Set xShell = Nothing
Set xFolder = Nothing
Set xFolderItem = Nothing
End Function

...zur Frage

For Steuervariabel wird bereits verwendet! was bedeutet das?

Hallo nochmals,

ich habe mit hilfe con einigen "gutefrage.net" usern einen code geschrieben und versuche jzt durch "Copy-Paste" es für jede Zelle anzuwenden.

Beim For-Befehl kommt immer folgende Meldung "For Steuervariabel wird bereits verwendet"

was bedeutet das ? heißt es, das man das "For" nur einmal in einem code gebrauchen kann ? wäre vielleicht ein "GoTo" befehl angebrachter? ( sprich: go to next cell, wenn die bedingung erfüllt ist )

hier ist der code:

sub kopieren( )

Dim Zelle As Range Dim Wert As Variant

Wert = ActiveSheet.Range("J16:j29")

With Sheets("Tabelle2") For Each Zelle In .Range("F6:G6")

If ((Range("J16").EntireRow.Hidden = True)

Or (Range("J16").EntireColumn.Hidden = True))

Or (Range("J16").Font.Strikethrough = True) Then

Zelle.Value = ActiveSheet.Range("J17")

Else

Zelle.Value = ActiveSheet.Range("J16")

With Sheets("tabelle2")

For Each Zelle In .Range("H6:I6")

If ((Range("J17").EntireRow.Hidden = True)

Or (Range("J17").EntireColumn.Hidden = True))

Or (Range("J17").Font.Strikethrough = True) Then

Zelle.Value = ActiveSheet.Range("J18")

Else

Zelle.Value = ActiveSheet.Range("J17")

End If End With End If Next Zelle End With End Sub

Danke schonmal für eure Tatkräftigen Hilfen :)))

Gruß Newb

...zur Frage

Wie setze ich das richtig in VBA um?

Hallo,

ich habe folgenden Code in Excel VBA. Leider komme ich nicht weiter.

Ich suche einen Wert der Zelle E1 in Spalte A1.

Ist der Wert aus E1 vorhanden, soll ein Sub geöffnet werden.

Ist dieser Wert nicht vorhanden, soll eine MsgBox geöffnet werden und nach dem Schließen der Box die UserForm1.

Aktuell macht der Code folgendes: Egal ob der Wert vorhanden ist oder nicht, es wird die MsgBox geöffnet und der Code wird auch bei richtiger Zahl nicht ausgeführt.

Ich würde mich freuen, wenn mir einer helfen kann bei meiner Spielerei. Danke.

Sub suche()
Dim zelle As Range


For Each zelle In Sheets("Tabelle1").Range("A1:A1000").Cells
    If zelle.Value = Sheets("Tabelle1").Range("E1") Then
    'Sheets("Tabelle1").Activate
    zelle.Activate
    Call create
    Exit For
    Else

    MsgBox "Nr. ist nicht vorhanden!", vbExclamation
    UserForm1.Show
    Exit Sub
    End If
    'Call create
    Next
End Sub

...zur Frage

VBscript OpenTextFile funktioniert nicht?

Hallo Leute,

ich Programmiere ja VBScript und habe jetzt eine Fehlermeldung und kriege diese nicht behoben:

Set fso = CreateObject("Scripting.FileSystemObject")

sl = InputBox("Wieviele Schüler sollten den Test machen?","")

'Gibt es eine "& sl &"ste Datei?

If fso.FileExists("D:\Lernprogrammmi\NomenMitEndungen\Tests\Temp\"& sl &".txt") Then

Do until Sl="0"

Set oFile = fso.OpenTextFile("D:\Lernprogrammmi\NomenMitEndungen\Tests\Temp\"& sl &".txt")

msgbox oFile.ReadLine

sl=sl-1

loop

Das Programm sollte in einer msgbox die Datei öffnen und danach auch die Dateien die unter der eingegebenen Zahl liegen öffnen und das bis null. Nun steht aber in dieser Zeile: "msgbox oFile.ReadLine" ein Fehler:

Eingabe hinter Dateiende

Kann mir da jemand helfen?

Außerdem möchte ich dass Alle Dateien in einer Abgespeichert werden aber so wie ich das erfahren habe klappt das nicht. Denn dann kreuzen sich zwei oFile's.

...zur Frage

VBA - Zwischenteil in Dateinamen ändern?

Hi zusammen,

ich muss folgende Dateinamen per Skriptfür rund 1000 Dateien wie folgt ändern:

Von:

3220022-8006-Amager_25_5_citrus-D-00

In:

3220022_8006_P_1

Den letzten Teil also D-00 in P_1 habe ich bereits hinbekommen. Wie ich jetzt aber alles nach dem ersten Zahlenpaar lösche weiß ich nicht.

Mein bisheriges Skript:

Sub Ordner_Auslesen()

'Bibliothek aktivieren

'Variablen dimensionieren

Dim fso As New FileSystemObject

Dim Pfad As String

Dim Ordner As Files

Dim Datei As File

'Pfad auslesen

Pfad = Tabelle1.Range("A1").Value

'Existiert der Ordner?

If fso.FolderExists(Pfad) Then

'Alle Dateien des Ordners einlesen

Set Ordner = fso.GetFolder(Pfad).Files

'Schleife über alle Dateien des Ordners

For Each Datei In Ordner

'Datei ausgeben

'Debug.Print Datei.Name

'Datei umbenennen

If InStr(Datei.Name, "D-00") <> 0 Then

Datei.Name = Replace(Datei.Name, "D-00", "P_1")

End If

Next Datei

Else

MsgBox "Dieser Ordner existiert nicht."

End If

End Sub

Kann mir jemand helfen?

...zur Frage

Ich benötige einen Makro, um ausgewählte Filter beim Schliessen zurück zu setzen. Aber mit dem Blattschutz funktioniert das nicht mehr. Kann mir jemand helfen?

Ich habe bisher diesen Makro benutzt:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim wksSheet As Worksheet
    For Each wksSheet In ThisWorkbook.Worksheets
        With wksSheet
            If .AutoFilterMode Then
                If .FilterMode Then
                    .ShowAllData
                End If
            End If
        End With
    Next wksSheet
    ThisWorkbook.Save
End Sub

...zur Frage

Mit VBA Dateien in einem Ordner umbenennen?

Ich habe es mithilfe vom Internet und einigen sehr wenigen Kenntnissen meinerseits geschafft, mir einen Code zu schreiben, mit dem ich Dateien (Fotos - also JPG-Dateien) umbenennen kann. Leider habe ich einen Teil des Codes gelöscht und dies gespeichert. Somit funktioniert leider gar nichts mehr und ich bekommen immer den Fehler, dass die Datei nicht gefunden werden kann. Die Meldung bekomme ich immer in der Zeile "Name File.Name As x".

Kann mir bitte jemand helfen?

Hier mein Code:

  Shell "Explorer.exe C:\Users\LANGEMIC.HILTI\Documents\Temp, vbNormalFocus"
  Set FS = CreateObject("Scripting.FileSystemObject")
  Set Folder = FS.GetFolder("C:\Users\LANGEMIC.HILTI\Documents\temp")
  
  Dim x As Single
  x = ActiveCell
  
  For Each File In Folder.Files
    If File.Name Like ".jpg" Then
      ActiveCell.Offset(1, 0).Select
      x = ActiveCell
      Name File.Name As x
      End If
  Next
End Sub

...zur Frage

Word VBa Initialize funktioniert nicht?

Das ist mein Code:


Private Sub ComboBox1_Initialize()

  ComboBox1.AddItem "weisungsbefugt "
  ComboBox1.AddItem "Meier"
  ComboBox1.AddItem "Schmitz"
  ComboBox1.AddItem "Weber"
  ComboBox1.AddItem "Mustermann"

  .ListIndex = 1 'Vorbelegung


End Sub





Private Sub ComboBox1_Change()
    


    Dim sPfad As String


    Inhalt = get_Word_ContenField_as_Text("DropBox1")


    MsgBox Inhalt


    Exit Sub


End Sub

Nur leider funktioniert der Initilialize Teil einfach nicht und ich weiß nicht was ich falsch mache? Ich bitte um Hilfe. Danke!

...zur Frage

Arbetismappe mit datum durchsuchen?

Hallo Zusammen,

ich habe eine Arbeitsmappe mit Tabellenblätter, wo sich die Namen variieren.

Da aber im jeden Tabellenblatt in Zelle A1 ein Datum Steht, will ich jedes Tabellenblatt dem Heutigen datum suchen, zellen aus dem blatt kopieren und in eine Andere arbeitsmappe einfügen, danach das gleiche noch einmal mit dem gestrigen datum.

Aktuell sieht mein Code so aus, aber der gibt mir nur die MsgBox, dass nichts gefunden worden ist.

  'Aktuelles Datum auswählen bei Start
Dim bolHabWasGefunden As Boolean
Dim wksTabelle As Worksheet
Dim rngSpalteA As Range
Dim rngZelleGefunden As Range
For Each wksTabelle In ThisWorkbook.Worksheets
 Set rngSpalteA = wksTabelle.Columns(1)
 Set rngZelleGefunden = rngSpalteA.Find(Date, LookIn:=xlValues)
 If Not rngZelleGefunden Is Nothing Then
  wksTabelle.Activate
  rngZelleGefunden.Select
  bolHabWasGefunden = True
  Exit For
 End If
Next
If bolHabWasGefunden = False Then
 MsgBox Date, , "Hab ich nicht gefunden:"
End If

Kennt da jemand einen ansatz bzw, eine lösung?

...zur Frage

VBA nur die ersten Unterordner anzeigen lassen?

Hallo,

wie muss ich diesen Code hier umschreiben damit NICHT die Unterordner der Unterordner angezeigt werden, sondern nur die der 'ersten Stufe'.

Also angenommen auf dem Laufwerk C:\ sind die Ordner

A, B, C, D, E

und diese Unterordner von C:\ enthalten jeweils auch Unterordner Namens
aa, bb, cc, dd, ee,

Dann schreibt der bisherige Code

A - aa
bb
cc
dd
ee
B - aa
bb

und so weiter.
Ich brauche aber nur die Ordner A, B, C, D, E und nicht deren Unterordner.

Public Sub OrdnerListen_Start()

Dim fso As Object
Dim strPfad As String

strPfad = "C:\"

With ActiveSheet

.UsedRange.ClearContents

Set fso = CreateObject("Scripting.FileSystemObject")

Call OrdnerListen(fso, strPfad, .Range("A1")) ' Pfad anpassen!

Set fso = Nothing

End With

End Sub

Private Sub OrdnerListen(fso As Object, Ordnerangabe As String, rng As Range, Optional Zeile As Long, Optional Spalte As Long)

On Error Resume Next

Dim o, uo

Set o = fso.GetFolder(Ordnerangabe)

rng.Offset(Zeile, Spalte).Value = o.Name
Zeile = Zeile + 1

For Each o In o.SubFolders

Call OrdnerListen(fso, o.Path, rng, Zeile, Spalte)

Set o = Nothing
Set uo = Nothing

End Sub

...zur Frage

Excel: Code für Versenden einer Mail?

Hallo Community, wie kann ich es hinbekommen, dass die Dateinicht nur in den Postausgang gelegt wird sondern auch versendet wird? hier mein Code:

    Sub ExcelDateiSendenMitText()
Dim Nachricht As Object, OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Dim AWS As String
'Aktive Arbeitsmappe wird als Mail gesendet
AWS = ThisWorkbook.FullName
Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.To = "xxxx@xxx.com; xxxxx@xxx.de"
.Subject = Range("F1") & Date & Time
.attachments.Add AWS
.Body = "text blabla"
'Hier wird die Mail nochmals angezeigt
.Display
'Hier wird die Mail gleich in den Postausgang gelegt
'Mail.Send
End With
'Outlook schliessen
'OutApp.Quit
Set OutApp = Nothing
Set Nachricht = Nothing
End Sub

Ich weiß nicht weiter bitte um hilfe

Danke schon mal im Voraus

...zur Frage

VBA UserForm KeyDown Sonderzeichen werden nicht erkannt?

Hallo, ich habe eine Frage zu meinem VBA Code. Und zwar sollen verschiedene Tastatureingaben verschiedene Funktionen triggern. Bei Zahlen, Buchstaben, Plus, Minus, "&"-Zeichen, "!"-Zeichen und einige andere Tasten gehen. "*"-Zeichen, Prozent, "(" und ")" bspw. gehen jedoch NICHT (als KeyCode wird 0 zurückgegeben). Hat jemand eine Ahnung woran das liegt?

Private Sub UserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  handleKeyDown KeyCode, Shift
End Sub

Private Sub handleKeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  Dim keyChar As String * 1
  keyChar = Chr(KeyCode)
  MsgBox (KeyCode)
  Select Case keyChar
  Case "0"
    numb0_Click
  Case "1"
    numb1_Click
  '.....
  Case Else
  End Select
  Select Case KeyCode
  Case "187"
    plus_Click
  '....
  Case Else 
  End Select
End Sub

Danke für alle Antworten,

Nicolas

...zur Frage

Excel VBA UserForm "Passwort ändern" funktioniert nicht?

Ich komme echt nicht weiter bei so einem einfachen Code! :(

Das Problem ist, dass die UserForm einmal funktioniert, aber beim zweiten Mal sagt er "Das Passwort ist nicht korrekt", obwohl es das eigentlich sein müsste. Per Direktbereich abgefragt ergibt sich dann immer, dass das Passwort auf "" steht. Findet jemand im Code den Fehler?

PS: "NeuesPasswort1" steht für die obere, "NeuesPasswort2" für die untere Reihe.

Option Explicit

Sub CheckBoxAltesPasswort_Click()
  If CheckBoxAltesPasswort.Value = True Then
    TextBoxAltesPasswort.PasswordChar = ""
    Else
      TextBoxAltesPasswort.PasswordChar = "*"
  End If
End Sub

Sub CheckBoxNeuesPasswort1_Click()
  If CheckBoxNeuesPasswort1.Value = True Then
    TextBoxNeuesPasswort1.PasswordChar = ""
    Else
      TextBoxNeuesPasswort1.PasswordChar = "*"
  End If
End Sub

Sub CheckBoxNeuesPasswort2_Click()
  If CheckBoxNeuesPasswort2.Value = True Then
    TextBoxNeuesPasswort2.PasswordChar = ""
    Else
      TextBoxNeuesPasswort2.PasswordChar = "*"
  End If
End Sub

Sub CommandButtonAbbrechen_Click()
  Me.Hide
End Sub

Sub CommandButtonSpeichern_Click()
  If TextBoxAltesPasswort.Value <> AltesPasswort Then
    MsgBox ("Das Passwort ist nicht korrekt.")
    Exit Sub
  End If
  If TextBoxNeuesPasswort1.Value <> TextBoxNeuesPasswort2.Value Then
    MsgBox ("Die Passwörter stimmen nicht überein.")
    Exit Sub
  End If
  If Len(TextBoxNeuesPasswort1.Value) < 5 Then
    MsgBox ("Bitte wählen Sie ein Passwort mit mindestens 5 Zeichen.")
    Exit Sub
  End If
  NeuesPasswort = TextBoxNeuesPasswort1.Value
  Passwort = NeuesPasswort
  Me.Hide
End Sub

Sub UserForm_Activate()
  AltesPasswort = Passwort
End Sub

...zur Frage

Excel 2013: Wert aus Variable (VBA) in Zelle schreiben?

Hi!

Ich sag jetzt schon mal danke für eure Antworten :)

Wie kann man den Wert der durch ein VBA-Makro in einer Variable steht in einer Zelle einfügen, so dass er da dauerhaft steht und auch aktualisiert wird, falls sich dieser Wert bzw. Variable ändert?

Sub Kommentarezaehlen()
 Dim Kom As Comment

 For Each Kom In ActiveSheet.Comments
     i = i + 1
  
 Next
 
 msg = MsgBox("Das blatt enthält " & i & " Kommentare")
End Sub

Vielen Dank Leute!

...zur Frage

Was möchtest Du wissen?

Deine Frage stellen