AW: hier gehts weiter, weil...
07.04.2014 17:30:18
rosa001
LEIDER NEIN :-(
Ich finde keinen Fehler und die Dateien liegen im gleichen Verzeichnis. Es ging ja auch immer, bis eben auf Deine letzte Änderung/Anpassung.
Sub sbSavedAs()
Dim lwbWB As Workbook, lboOpen As Boolean
Dim lshThis As Worksheet, lsh2 As Worksheet
Dim lloRow As Long, lboUpd As Boolean
For Each lwbWB In Workbooks
If LCase(lwbWB.Name) = LCase("Mobile Service Case Tracking.xlsm") Then 'WICHTIG!!!! _
anstelle von Datei2.xls musst du den richtigen Namen von Datei2 eintragen!
lboOpen = True
Exit For
End If
Next
If lboOpen = False Then
Workbooks.Open ThisWorkbook.Path & "\Mobile Service Case Tracking.xlsm" 'WICHTIG!!!! _
anstelle von Datei2.xls musst du den richtigen Namen von Datei2 eintragen!
End If
Set lshThis = ThisWorkbook.Sheets("Report")
Set lsh2 = Workbooks("Mobile Service Case Tracking.xlsm").Sheets("Cases") 'WICHTIG!!!! _
anstelle von Datei2.xls musst du den richtigen Namen von Datei2 eintragen!
With lsh2
For lloRow = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
If .Range("A" & lloRow).Value = lshThis.Range("C2").Value Then
lboUpd = True
Exit For
End If
Next
If lboUpd = True Then
If MsgBox("Die Tracking-Number " & lshThis.Range("C2").Value & " ist _
schon vorhanden." & vbCrLf & _
"Sollen die Werte überschrieben werden?", vbYesNo + _
vbQuestion, "Überschreiben Ja/Nein?") = vbNo Then
Set lshThis = Nothing
Set lsh2 = Nothing
Exit Sub
End If
sbToSave lshThis, lsh2, False, lloRow
Else
sbToSave lshThis, lsh2, True, 0
End If
End With
Set lshThis = Nothing
Set lsh2 = Nothing
Workbooks.Open pvarSaved
ThisWorkbook.Close False
End Sub
Sub sbToSave(ByVal dieses As Worksheet, ByVal blatt As Worksheet, ByVal neuer_eintrag As _
Boolean, ByVal zeile As Long)
Dim larstrFilename() As String
ChDrive "C:\"
ChDir "C:\Users\lz5sdn\Desktop\Temp\MSCT" '"C:\Data"
pvarSaved = Application.GetSaveAsFilename(dieses.Range("C2").Value, fileFilter:="Excel- _
Arbeitsmappe, *.xlsm")
If pvarSaved "Falsch" Then
larstrFilename = Split(pvarSaved, "\")
If ThisWorkbook.Name larstrFilename(UBound(larstrFilename)) Then
If fcYesNo(pvarSaved, larstrFilename(UBound(larstrFilename))) = _
False Then
ThisWorkbook.SaveCopyAs pvarSaved
End If
Else
If fcYesNo(pvarSaved, larstrFilename(UBound(larstrFilename))) = _
False Then
ThisWorkbook.Save
End If
End If
Else
'WICHTIG!!!! anstelle von Datei2.xls musst du den richtigen Namen von Datei2 _
eintragen!
MsgBox "Es wurde keine Datei gespeichert." & vbCrLf & "Es werden keine Daten in _
'Mobile Service Case Tracking' übertragen." & vbCrLf & "Der Vorgang wird abgebrochen.", , "Abbruch"
End
End If
With blatt
If neuer_eintrag = True Then
zeile = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Range("A" & zeile).Value = dieses.Range("C2").Value
End If
.Range("I" & zeile).Value = dieses.Range("C6").Value
.Range("T" & zeile).Value = dieses.Range("E6").Value
.Range("N" & zeile).Value = dieses.Range("E9").Value
.Range("A" & zeile).Hyperlinks.Add Anchor:=.Range("A" & zeile), Address:=pvarSaved, _
TextToDisplay:=.Range("A" & zeile).Value
Application.Goto .Range("A" & zeile), True
.Range("A" & zeile & ":AN" & zeile).Select
End With
End Sub
Function fcYesNo(ByVal pfadname As String, dateiname As String) As Boolean
If Dir(pfadname) "" Then
If MsgBox("Soll die Datei " & dateiname & " überschrieben werden?", vbYesNo + _
vbQuestion, "Überschreiben Ja/Nein?") = vbNo Then
'WICHTIG!!!! anstelle von Datei2.xls musst du den richtigen Namen von Datei2 _
eintragen!
MsgBox "Es wurde keine Datei gespeichert." & vbCrLf & "Es werden keine Daten in ' _
Mobile Service Case Tracking' übertragen." & vbCrLf & "Der Vorgang wird abgebrochen.", , "Abbruch"
End
End If
End If
End Function
