I am having a frustrating time trying to do create a backup script in VBA. I get an error 'File not found' when trying to kill a file after opening it, making a backup and saving it under a new name.
Application.Workbooks.Open Old
ActiveWorkbook.SaveAs Archive
ActiveWorkbook.SaveAs New
'If Len(Dir$(Old)) > 0 Then Kill Old
If Len(Dir$(Old)) = 0 Then MsgBox ("bleuh")
'Here is where I get the message "Bleuh" even though Old was just opened a few lines ago..
The first line works fine, but when I want to kill the file 'Old', I get the error. Hence, I tried to test whether the file existed. The result was the Msg "Bleuh". So the file can be opened, but not found a few lines later. Can anyone explain this and help me?
In order to be complete, the entire code is found down here.
Sub UpdateAll()
Dim Afk As String, J As String, NJ As String, Path As String, strFile As String, Old As String, Archive As String, New As String
'Dim fso As Object
Path = "C:\Users\Name\OneDrive - Company\Desktop\Testing backup" & "\"
Year = Year(Date)
VJ = Year
NJ = Year + 1
Application.ScreenUpdating = False
'test for Afk (I define Afk for some additional functions that are not relevant for this problem)
Afk = "ABA"
'filenames
Old = Path & ("Planning ") & VJ & Space(1) & Afk
Archive = Path & ("Planning\Archive ") & VJ & Space(1) & Afk
New = Path & ("Planning ") & NJ & Space(1) & Afk
Application.Workbooks.Open Old
ActiveWorkbook.SaveAs Archive
ActiveWorkbook.SaveAs New
If Len(Dir$(Oud)) > 0 Then Kill Old
If Len(Dir$(Oud)) = 0 Then MsgBox ("bleuh")
'Here is where I get the message "Bleuh" even though Old was just opened a few lines ago..
'Also tried
'fso.CopyFile Old, Archive 'AND
'FileCopy Old, Archive
'in combination with:
'Name Old As New
' "SSDD"
'Next
Application.ScreenUpdating = True
End Sub
After analyzing your code I realized you don't need to open your file ('cause you don't get any information from it). You just want to move it. So, try the following:
Name Old as Archive
This should do the trick...
Related
This is the code, which works in 5.7.5 but not later.
Public Shared Sub PopulateXlsm(Filein As FileInfo, Fileout As FileInfo)
Dim src As ExcelWorksheet, tgt As ExcelWorksheet
Dim srcEndRow As Integer, tgtStartRow As Integer
Dim newFile As String
newFile = Fileout.Directory.ToString & "\" & Filein.Name
If Dir(newFile) <> "" Then
MsgBox("File: " & Filein.Name & " already exists in output directory")
Exit Sub
End If
Using wbIn = New ExcelPackage(Filein)
Using wbout = New ExcelPackage(Fileout)
src = wbIn.Workbook.Worksheets(0)
tgt = wbout.Workbook.Worksheets(0)
' This subroutine will copy completed ledger file(s) into combined ledger
transaction file
' find first blank record in target to write new records to
tgtStartRow = NextRow(tgt, "", 4)
srcEndRow = src.Dimension.Rows ' last line incl totals
' copy the new records from source to destination
src.Cells(4, 1, srcEndRow, 17).Copy(tgt.Cells("A" & tgtStartRow + 1))
wbIn.Save()
wbout.Save()
' all done!
End Using
End Using
'move file to new directory
Filein.MoveTo(Fileout.Directory.ToString & "\" & Filein.Name)
End Sub
The error occurs when attempting the cells.copy line. Downgrade back to 5.7.5 and the program runs properly again. The error message is:
System.ArgumentOutOfRangeException: 'Specified argument was out of the
range of valid values. Parameter name: Start cell Address must be less
or equal to End cell address'
This is thrown in "OfficeOpenXml.ExcelAddressBase.Validate()"
I have a list of file names in a worksheet. I want to read a name, find the actual file, rename it and move on to the next name.
The 1st part, retrieving the name from the worksheet and modifying it to the new name is not a problem. The problem is assigning the new name to the file.
The Name function does not work because the files are on a different drive. I also tried Scripting.FileSystemObject.
The code runs but no change is made.
Here is the code I used...
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set f = fso.GetFile(fOldName)
If Not Err = 53 Then 'File not found
'Rename file
f.Name = fNewName
End If
Did I make a code mistake I'm not seeing? Should I be using/doing something else?
Finding info on VBA and/or VB6 is getting pretty rare these days.
BTW. This is for Excel 2016.
Tks
If there was no misunderstanding...
FSO... it's bad in any case. It's just a bugsful API wrapper, written with a left chicken paw.
There are pure VB & API for more sophisticated cases.
No external libs & objects:
Public Sub sp_PrjFilMov()
Dim i As Byte
Dim sNam$, sExt$, sPthSrc$, sPthTgt$, sDir$
sPthSrc = "V:\"
sPthTgt = "R:\"
sNam = "Empty_"
sExt = ".dmy" ' dummy
For i = 1 To 5 ' create set of files for test
Call sx_CrtFil(i, sPthSrc, sNam, sExt)
Next
sDir = Dir(sPthSrc & "*" & sExt, vbNormal) ' lookup for our files ..
Do
'Debug.Print sDir
Select Case LenB(sDir)
Case 0
Exit Do ' *** EXIT DO
Case Else
Call sx_MovFil(sPthSrc, sDir, sPthTgt) ' .. & move them to another disk
sDir = Dir
End Select
Loop
Stop
End Sub
Private Sub sx_CrtFil(pNmb As Byte, pPth$, pNam$, pExt$)
Dim iFilNmb%
Dim sFilNam$
sFilNam = pPth & pNam & CStr(pNmb) & pExt
iFilNmb = FreeFile
Open sFilNam For Output As #iFilNmb
Close #iFilNmb
End Sub
Private Sub sx_MovFil(pPnmSrc$, pFnm$, pPthTgt$)
Dim sSrcPne$
sSrcPne = pPnmSrc & pFnm
'Debug.Print "Move " & sSrcPne & " --> " & pPthTgt
Call FileCopy(sSrcPne, pPthTgt & pFnm)
Call Kill(sSrcPne)
End Sub
'
I’ve made a simply macro to change names of files in a directory. At first it seemed correct, but then I’ve noticed something strange. For instance there is 48 files in a directory and initially the macro numbers files properly – “1”, “2”, “3” and so forth (in Immediate window the variable “i” changes from 1 to 49), but if I run the macro several times, sometimes the variable “i” changes from 1 to 148 and a first number of files starts from 100: “100”, “101”, “102” et cetera. Then I run the macro again and it counts files properly, then – again – an error mentioned above occurs … and so on. I don’t see any rule in it. Any help is greatly appreciated.
Sub nameChange()
Dim source As FileSystemObject
Dim fold As folder
Dim fObj As File
Dim path As String, newName As String, number As String, ext As String
Dim i As Long
On Error GoTo closeSub
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
path = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
End With
Set source = New FileSystemObject
Set fold = source.GetFolder(path)
i = 1
newName = InputBox("New name")
For Each fObj In fold.Files
ext = Mid(fObj.Name, (InStrRev(fObj.Name, ".")))
Name fObj As path & "\" & newName & i & ext
i = i + 1
Next fObj
closeSub:
Exit Sub
End Sub
I couldn't find an existing thread fitting my problem and now I'm stuck and searching for help ;)
What I want to accomplish: Several .xlsx tables filled with content are in the same folder, I want to pick the same two cells' content out of every file and save it to a newly created .xslx file named "Summary.xlsx".
My makro reads out the cells' content properly and also saves the Summary.xlsx. However it looks like the file is corrupted because when I try to open it Excel would show me just a blank page (not even a sheet).
Watching the file using breakpoints, the headlines get written properly: However the table in Summary.xlsx starts to disappear right when I try to write the content of the other files in the do-while-loop.
Additional info: I start the makro from an extra makro-file in the same directory as the other files using the play button in the module.
Here's my code.
Warning: I'm new to VBA, obviously :)
Sub MergeMakro()
Dim directory As String, fileName As String, otherWorkbook As Workbook, sumFileName As String, sumFilePath As String, i As Integer
thisFileName = "MergeMakro.xlsm"
sumFileName = "Summary.xlsx"
sumFilePath = ThisWorkbook.Path & "\" & sumFileName
' If sum file already exists, delete it
If Dir(sumFilePath) <> "" Then
Kill (sumFilePath)
End If
' create new sum file
Set sumWorkbook = Workbooks.Add
ActiveWorkbook.SaveAs fileName:=sumFilePath
Set sumSheet = sumWorkbook.ActiveSheet
' search in the file's directory
directory = "R:\ExcelStuff\Auswertungen\"
' headlines -> are written properly
sumSheet.Range("A1") = "Materialnummern"
sumSheet.Range("B1") = "Bezeichnung"
sumSheet.Range("C1") = "Gesamtkosten"
' start at line 2
i = 2
fileName = Dir(directory & "*.xls")
Do While fileName <> ""
If fileName <> thisFileName And fileName <> sumFileName Then
Set otherWorkbook = Workbooks.Open(directory & fileName)
' do not show windows
If Not (ActiveWorkbook Is Nothing) Then
ActiveWindow.Visible = False
End If
' remove last 5 chars of string (.xlsx)
fileName = Left(fileName, Len(fileName) - 5)
' do not try to open the makro-file itself
Set otherSheet = otherWorkbook.Sheets(fileName)
' write data into file -> here the file starts to get corrupted
sumSheet.Range("A" & i) = fileName
sumSheet.Range("B" & i) = otherSheet.Range("C4")
sumSheet.Range("C" & i) = otherSheet.Range("G4")
i = i + 1
otherWorkbook.Close
End If
' get the next file
fileName = Dir()
Loop
Workbooks(sumFileName).Save
Workbooks(sumFileName).Close
End Sub
Thanks in advance!
I'm pulling my hair out on this one.
I put together some code for opening a file associated with records in our database. Newer data has full file paths stored as text in a separate table. Old data does not have a full file path but has enough details to assemble a working path in most cases.
My code checks to see if the older data fields are null and if they are proceed to the newer filepath.
The problem I'm having is with DLookup in the IF statement being stuck on the first file it was used on. No matter what I do, DLookup always returns the same result as the first time I ran the code. I'm stumped.
Private Sub btnOpenFile_Click()
Dim FacID As String
Dim FacIDShort As String
Dim CDID As String
Dim FileName As String
Dim FileURL As String
FacID = [FAC_ID]
FacIDShort = Left(FacID, 4)
On Error GoTo ErrHandler
If IsNull([CD_NUM]) Then ' Checks to see if old file path exists before trying new file path
FileURL = DLookup("[File_Path]", "tblFileDirectory", "[Drawing_ID]")
Application.FollowHyperlink (FileURL)
Else
CDID = [CD_NUM]
FileName = [FILENAME]
FileURL = ("\\SYSTEMXXX\" & FacIDShort & "\" & FacID & "\FILES\" & CDID & "\" & FileName)
Application.FollowHyperlink (FileURL)
End If
Exit Sub
ErrHandler:
LogError (FileURL)
MsgBox ("Error: " & FileURL & vbNewLine & "The URL Does Not Exist.")
End Sub
DLookup("[File_Path]", "tblFileDirectory", "[Drawing_ID]" should actually be more like DLookup("[File_Path]", "tblFileDirectory", "MyDrawingIdColumnInTable = MyDrawingIdToLookFor"