Excel VBA File save - excel

I am trying to set up an auto save function on an excel template so that the original template isnt over written.
Dim NameFile As String
'Gets the users username
UserName = Environ$("UserName")
'User is to input data type
datat= Application.InputBox("Enter a Data Type", "Data Type")
With Worksheets("Home")
'Sets up auto filename with YearMonthDay - Username - Filename(From a specific Cell) - Data Type
NameFile = Format(Date, "yyyymmd") & " - " & UserName & " - " & Range("A1") & " - " & datat & ".xlsm"
End With
'Sets up save location
NameFile = Application.GetSaveAsFilename(InitialFileName:=Environ("USERPROFILE") & "\Desktop\" & NameFile, Filefilter:=" Excel (*.xlsm), *.xlsm")
If NameFile = False Then
'Tell user with a caution that the file has not been saved
MsgBox "File not saved", vbCritical, "Caution"
Exit Sub
Else
ThisWorkbook.SaveAs Filename:=NameFile
MsgBox "File Saved"
End If
When I dont save the file and click cancel i get the message box telling me that the file hasnt been save... which is what I want.
But when I do save the file with the given name I get a Run-Time error '13', Type Mismatch
What am I doing wrong?

You should Dim NameFile as Variant
That way it can hold either a Boolean or a String.

Related

How do I add a network path to a name in excel name manager

I have code that works to add a path to a name in the name manager, but only for local paths. When I try to use a network path, the name manager adds a colon before the first single backslash, which keeps the path from working. I have added code to debug, to remove colons, which it seems wasn't necessary. The File open dialog does return the correct path. VBA writes it like this with debug.print:
`="\\win10box3\business\... ..." `
When excel stores it in the name manager it stores it like this
`="\\Win10Box3:\Business\... ..." `
I wrote code to remove the colon before adding the name, but I'm finding the path debug.prints correct before it is stored in the Name Manager, even before the loop to remove the colon.
The only solution I have found is to manually edit the path in the name manager to remove the colon
Sub GetPath()
Debug.Print "Start GetPath routine"
'This sub gets the path to a File defined by the user within the routine
'It then calls another sub that applies that path to a name in the worksheet.
' Before calling this routine, The name should first be searched for, and then verified, then opportunity given to change the name.
Dim MyPath As String 'String to hold the path to an excel spreadsheet exported from quickbooks
Dim NametoChange As String 'String that holds the name manager name to store the path under
Dim NameComment As String 'Comment to identify the name in the name manager
Dim PathLength As Long
Dim PathTemp As String
NametoChange = "PathToEmployeeWithholding"
NameComment = "This Name contains the Path to the 'Employee Withholding' worksheet exported from quickbooks using VBA"
MyMessage = "If you have not already exported and" & vbCrLf & "saved the employee withholding data from Quickbooks," & vbCrLf & "Please choose cancel and export it now"
DoIt = MsgBox(MyMessage, vbOKCancel)
Debug.Print DoIt
If DoIt = vbCancel Then
Exit Sub
End If
With Application.FileDialog(msoFileDialogFilePicker)
If .Show <> 0 Then
MyPath = .SelectedItems(1)
End If
End With
Debug.Print MyPath 'NOTE:This is producing the correct path. It has no colon here...
'Where is the colon coming from?
'IT SEEMS NECESSARY TO REMOVE A COLON IF THE PATH IS A NETWORK PATH
'FIRST VERIFY IT IS NOT A DRIVE PATH... SHOULD BE IN THE FORM OF D:\
'WHAT IS UNIQUE IS THE COLON IS THE 2ND CHARACTER IN THE PATH IF A LOCAL DRIVE.
'TEST TO SEE IF THE INCREMENT IS 2. IF IT IS, SKIP IT, AND REMOVE ALL OTHER COLONS
PathLength = Len(MyPath)
For i = 1 To PathLength
If Not i = 2 Then
If Not Mid(MyPath, i, 1) = ":" Then
PathTemp = PathTemp & Mid(MyPath, i, 1)
End If
Else
PathTemp = PathTemp & Mid(MyPath, i, 1)
End If
Debug.Print "i = " & i & " The current Character is " & _
Mid(MyPath, i, 1) & xlcrlf & "the current PathTemp is " & PathTemp
Next
MyPath = PathTemp
Debug.Print MyPath
Debug.Print "Calling ChangeValueOfName Routine"; vbCrLf & vbCrLf
Call ChangeValueOfName(NametoChange, MyPath, NameComment) 'this routine stores the retrieved text string in the name manager
Debug.Print "Exit GetPath Routine" & vbCrLf & vbCrLf
End Sub
Sub ChangeValueOfName(NametoChange As String, NewNameValue As String, Comment As String)
Debug.Print "Start changeValueOfName routine"
' ChangeValueOfNameManagerName Macro
' Changes the Value of a defined name in the Name Manager
'This should be used to change the name.
'Once the file is selected data needs to be imported to an array, and the
'Employee name values need to be checked against the worksheets in the workbook and against the recap sheet
'If changes are needed, it needs to write them into the workbook, including changing recap sheet and adding
'worksheets for any new employees
With ThisWorkbook.Names(NametoChange)
.Name = NametoChange
.Comment = Comment
RefersToR1C1 = _
"=" & Chr(34) & NewNameValue & Chr(34)
End With
Debug.Print "The New Path added is " & "=" & Chr(34) & NewNameValue & Chr(34)
Debug.Print "Return from ChangeValueOfName routine" & vbCrLf & vbCrLf
End Sub

Excel VBA save file as word document in default folder

Sub Submit_Click()
Dim wApp As Object
Dim wDoc As Object
Set wApp = CreateObject("Word.Application")
wApp.Visible = True
'Retrieves the word doc template and inserts values from the userform using bookmarks
Set wDoc = wApp.Documents.Open(Filename:="C:\Users\Documents\template1.docx ", ReadOnly:=False)
With wDoc
.Bookmarks("bookmark1").Range.Text = Me.TextBox1.Value
.Bookmarks("bookmark2").Range.Text = Me.TextBox3.Value
.Bookmarks("bookmark3").Range.Text = Me.TextBox4.Value
.Bookmarks("bookmark4").Range.Text = Me.TextBox5.Value
'set the default filename
ProposedFileName = Format(Now(), "DD-MMM-YYYY") & "Serial Number" & " " & TextBox1.Value _
& " " & TextBox2.Value & "- RMA" & ".docx"
'trying to save file back to .doc instead of the default .xlms format
Set fd = Application.FileDialog(msoFileDialogSaveAs)
With fd
.FilterIndex = 2
.InitialFileName = ProposedFileName
If .Show Then
ActiveDocument.SaveAs2 Filename:=.SelectedItems(1), _
FileFormat:=wdFormatDocumentDefault
Else
Call CommandButton4_Click 'cancel save
End If
End With
Set fd = Nothing
End Sub
Hi all,
My script above is only a partial one that is taken from my userform. Basicall the scenario is my userform opens a word document template and inserts texts in the document from the excel userform using bookmarks.
After I click submit on the userform, the filedialog opens with the default .xlms and does not allow me to save it back to .doc
I have been searching and modifying my script for ages and cannot seem to get it right. I would appreciate if someone can tell me how. Thank you.
Regards,
Kev
Private Sub SubmitButton_Click()
'set default file name and file path
ProposedFileName = Format(Now(), "DDMMMYYYY") & " " & TextBox1.Value & "-" & TextBox2.Value & ".doc"
ProposedFilePath = "C:\Users\"
'save the word document called by excel to a .doc format
With wApp.FileDialog(msoFileDialogSaveAs)
wDoc.SaveAs2 ProposedFilePath & ProposedFileName, _
FilterIndex = 1, _
FileFormat:=wdFormatDocument
End With
'unloads the userforms and .doc file after the document is saved
Unload Me
wApp.Quit
'a dialog box pops up after document is saved to say where the file is saved since I was't unable to implement the browse folder option
MsgBox "The document is saved in " & ProposedFilePath, vbOKOnly
Cancel = False
Exit Sub
End Sub
Hi All,
Thank you for the help. I have managed to solve my problem with the above code but unfortunately could not do it with the browse location dialog box. I hope this will become useful for everyone who needs it.
However, if anyone knows how to implement the browse folder location with this code will be better and useful for others.

Excel vba Next invoice number with creation of automatic directory folder by month

Ok , here is the thing,
I have created a next invoice number program in which by pressing of a macro assigned button active invoice automatically saved and closed and the next invoice with a number increased appear.My problem is that, I want excel invoices to be created in their relevant folder by their first two digits of invoice number . as an example : 04-001 where 04 stands for April. also, when invoice number is given 05-002, the directory folder of may 2018-19 should be auto created and invoice should be there in the folder only. i am trying to figure out the code since some time but no luck till now. So far , The invoices are created according to date only but as darren said it is a problem for me when i am trying to create invoices from december on first day of january.
This is my current code :
Sub SaveInvoiceM()
Dim NewFN As Variant
If Len(Dir("C:\Invoices\" & Format(Date, "MMM YYYY") & "-" & (Format(Date, "YY") + 1), vbDirectory)) = 0 Then
MkDir "C:\Invoices\" & Format(Date, "MMM YYYY") & "-" & (Format(Date, "YY") + 1)
End If
' Copy Invoice to a New Workbook
NewFN = "C:\Invoices\" & Format(Date, "MMM YYYY") & "-" & (Format(Date, "YY") + 1) & "\Inv" & Range("F5") & ".xlsx"
ActiveWorkbook.saveas NewFN, FileFormat:=xlOpenXMLWorkbook
NextInvoice
End Sub
Range("F5") stands for my invoice number which is 04-001
I see what you are trying to do (keep nicely organized, automatically) and that's an excellent goal.
I have a suggestion of an alternate invoice numbering system (based on what I'm understanding of your situation & experience level) that will make tasks (like this "auto-filing" process) much easier, and will also simplify the process any time you (or especially anyone else) needs to look back at these invoices. There are a number of obvious benefits (same idea as metric vs imperial).
Ideal numbering system: (in my opinion)
To reduce confusion: Give each invoice and filename the same name instead of having a filename with a month and
Since you want granularity from months to years (but not days): make the invoice/file name include the all of those fields.
To make sorting & finding these logical (easier): place each "date part" in order of biggest to smallest. A unique sequential number goes at the very end.
Your code sample was a good start - I just have a bit of OCD when it comes to this kind of thing, and creation of a numbering system is an important task. (Also this will be "date-proof", and error-checked along the way...
This is a little different than what you had because instead of you telling the code what the next invoice number is, it tells you (by figuring out the next number in sequence based on the existing files).
Like yours, it creates a folder if necessary. Since the files are number YYMM-nnn then are always in the correct order when you sort them. (The "month folders" are unnecessary since the month is in the filename, but I included them anyway since that was your plan. You could just keep every month's invoices in one folder, and they'd still be organized in order of month.)
VBA #1: Save file with next sequential invoice number (creating folder if necessary)
Sub createInvoiceNumberAndSave()
'creates a new invoice number based on date in specified cell & creates new folder if necessary
'finds next unused invoice number & verifies that file is properly saved
Const invoicePath = "c:\invoices\" ' invoice root save path
Const fNamePrefix = "Inv" ' prefix for the filename
Const fNameExt = ".xlsm" ' file extension
Const getInvoiceDate = "F5" ' we GET the DATE of the invoice from F5
Const putInvoiceNumber = "F6" ' we will PUT the new filename into cell F6
Dim invDate As Date, folderName As String, fName As String, fNum As Long, nextInvoiceNum As Long
'get the invoice date and make sure it's valid
If IsDate(Range(getInvoiceDate).Value) Then
'valid date found in cell F5
invDate = Range(getInvoiceDate).Value
Else
'valid date not found in F5. Do we want to default to today's date?
If MsgBox("Cell " & getInvoiceDate & " does not contain a valid date." & vbLf & vbLf & _
"Do you want to use today's date instead?", vbQuestion + vbOKCancel, "Date not found") <> vbOK Then
Call MsgBox("Invoice Not Saved.", vbCritical + vbononly, "User Cancelled")
Exit Sub 'stop running
Else
invDate = Date 'use today's date
End If
End If
'find the next unused invoice number for this month
folderName = Format(invDate, "YYMM")
nextInvoiceNum = 0
'figure out the next unused "file number"
fName = Dir(invoicePath & folderName & "\" & fNamePrefix & folderName & "-*" & fNameExt)
If fName = "" Then
'file not found
If Dir(invoicePath & folderName, vbDirectory) = "" Then
'month not found - create folder?
If MsgBox("Okay to create folder '" & invoicePath & folderName & "' for invoice #" & folderName & "-001 ?", _
vbOKCancel + vbQuestion, "Folder not Found") <> vbOK Then Exit Sub
'create folder
MkDir (invoicePath & folderName)
End If
Else
'month found. Now find the highest invoice number in the folder.
Do While fName <> ""
Debug.Print "Found File: " & fName
'get the number (filename = fNamePrefix & "YYMM-___.xlsx" so we know where it is
If IsNumeric(Mid(fName, 6 + Len(fNamePrefix), 3)) Then 'it's a valid number
fNum = Val(Mid(fName, 6 + Len(fNamePrefix), 3))
'if it's the biggest so far, remember it
If fNum > nextInvoiceNum Then nextInvoiceNum = fNum 'biggest one so far
End If
fName = Dir
Loop
End If
'we have the next available invoice#
nextInvoiceNum = nextInvoiceNum + 1 'new invoice# (numeric)
'PUT the new invoice# (text) in cell F6
Range(putInvoiceNumber).Value = fNamePrefix & folderName & "-" & Format(nextInvoiceNum, "000")
fName = invoicePath & folderName & "\" & Range(putInvoiceNumber).Value & fNameExt
Debug.Print "Saving as: " & fName
'save file
ActiveWorkbook.SaveAs fName
'DOUBLE CHECK check that file exists (couple lines of code now save a headache later)
If Dir(fName) = "" Then
'something went wrong (file wasn't saved)
Call MsgBox("ERROR! FILE NOT SAVED: " & fName, vbCritical + vbOKOnly, "ERROR!")
Stop
End If
'success message!
Call MsgBox("Invoice saved successfully:" & vbLf & vbLf & fName, vbInformation, "Invoice Created")
'NextInvoice '?
End Sub
EDIT: ("Back to your way")
I can think of a number of ways that your method will be a problem, some of which I tried explaining, but you're determined to number & organize these files your way, so "here you go".
VBA #2: Save file with cell value as name:
This procedure saves the current file, named from the invoice number (like 04-001) that you enter in cell F5 (creating folder if necessary):
Sub SaveFileBasedOnInvoiceNumber()
Dim monthNum As Long, yearString As String, folderName As String, fName As String
'build filename
On Error Resume Next 'skip errors for now
monthNum = Val(Left(Range("F5"), 2))
yearString = Year(Date) & "-" & Right(Year(Date) + 1, 2)
folderName = "c:\invoices\" & StrConv(monthName(monthNum, True), vbUpperCase) & " " & yearString
fName = folderName & "\INV" & Range("F5") & ".xlsm"
'check if there was a problem
If Err Then MsgBox "Invalid invoice number": Exit Sub
MkDir (folderName) 'create folder
On Error GoTo 0 'turn error checking back on
'Confirm file saved properly
ActiveWorkbook.SaveAs fName 'save file
If Dir(fName) = "" Then MsgBox "Error! File not saved: " & fName: Exit Sub
MsgBox "Invoice saved successfully:" & vbLf & fName
End Sub
I'll leave "VBA #1" in the the top of the answer for others seeking a logical numbering & storage system with auto-generated invoice numbers.
(One day you'll figure out why that way would've been better, but be forewarned, it will be a lot more of a hassle to change your organization method later!)
Good luck!

ActiveWorkbook.SaveAs excel 2013 1004 error

I am getting a
Run-time error '1004' Method 'SaveAs' of object '_Workbook' failed.
The code works in excel 2010. I only get this error message in excel 2013.
The error message appears after trying to run the follow line.
ActiveWorkbook.SaveAs FolderPath & SaveName & NewSaveExt, 52
Background:
The spreadsheet is an .xls
When using the Saveas I am changing it to .xlsm
I have tried it with a .xls extension and fileformat 56 and it still falls over.
I am using code from the resources listed in the code.
I am saving the file to the same folder the workbook is in.
The orignal file name is: Financial Report as at month N.xls
The new filename is : Financial Report 1516 as at month 8.xlsm
Sub SaveNewVersion_Excel()
'PURPOSE: Save file, if already exists add a new version indicator to filename
'SOURCE: www.TheSpreadsheetGuru.com/The-Code-Vault
Dim FolderPath As String
Dim myPath As String
Dim SaveName As String
Dim SaveExt As String
Dim NewSaveExt As String
Dim VersionExt As String
Dim Saved As Boolean
Dim x As Long
TestStr = ""
Saved = False
x = 0
NewSaveExt = ".xlsm"
'Version Indicator (change to liking)
VersionExt = "_v"
'Pull info about file
On Error GoTo NotSavedYet
myPath = ActiveWorkbook.FullName
myFileName = "Financial Report " & FileFinancialYear & " as at month " & MonthNumber
FolderPath = Left(myPath, InStrRev(myPath, "\"))
SaveExt = "." & Right(myPath, Len(myPath) - InStrRev(myPath, "."))
On Error GoTo 0
'Determine Base File Name
If InStr(1, myFileName, VersionExt) > 1 Then
myArray = Split(myFileName, VersionExt)
SaveName = myArray(0)
Else
SaveName = myFileName
End If
'Test to see if file name already exists
If FileExist(FolderPath & SaveName & SaveExt) = False Then
ActiveWorkbook.SaveAs FolderPath & SaveName & NewSaveExt, 52
Exit Sub
End If
'Need a new version made
Do While Saved = False
If FileExist(FolderPath & SaveName & VersionExt & x & SaveExt) = False Then
ActiveWorkbook.SaveAs FolderPath & SaveName & VersionExt & x & NewSaveExt, 52
Saved = True
Else
x = x + 1
End If
Loop
'New version saved
MsgBox "New file version saved (version " & x & ")"
Exit Sub
'Error Handler
NotSavedYet:
MsgBox "This file has not been initially saved. " & _
"Cannot save a new version!", vbCritical, "Not Saved To Computer"
End Sub
Function FileExist(FilePath As String) As Boolean
'PURPOSE: Test to see if a file exists or not
'RESOURCE: http://www.rondebruin.nl/win/s9/win003.htm
Dim TestStr As String
'Test File Path (ie "S:\Reports\Financial Report as at...")
On Error Resume Next
TestStr = Dir(FilePath)
On Error GoTo 0
'Determine if File exists
If TestStr = "" Then
FileExist = False
Else
FileExist = True
End If
End Function
Error reproduction: I was able to reproduce the error when trying to save a workbook with a FileName that already exist.
This could happen because the code checks the existence of a file named with extension SaveExt (using Function FileExist) but then try to save it as a file named with extension NewSaveExt. If these extensions are not the same then it’s possible that the file named with extension NewSaveExt already exist raising the
Run-time error ‘1004’: Method ‘SaveAs’ of object ‘_Workbook’ failed.
However this alert:
A file ‘Financial Report as month .xlsm’ already exist in this
location. Do you want to replace it?.
Should have been displayed before the error 1004
Unfortunately I cannot test the code posted in Excel 2010, but I personally think this behavior is not exclusive of Excel 2013.
Solution: If the objective is to always save the file as xlsm (value of NewSaveExt) then the code should validate the existence of a filename with that extension.
Additional comments about the code posted:
It’s a best practice to declare all variables. These variables are not declared:
TestStr, FileFinancialYear, MonthNumber, myFileName, myArray
These lines are redundant as no need to initialize variables that have not been used as yet, so they are already holding their initialized value.
TestStr = ""; Saved = False; x = 0
Suggest to use constant instead of variables for these (see Variables & Constants)
NewSaveExt = ".xlsm"; VersionExt = "_v"
New workbooks are not detected as the error handler NotSavedYet which is supposed to be triggered when the ActiveWorkbook has not been saved before (i.e. a new workbook) never gets fired as none of the commands between the On Error statements generate an error when dealing with new workbooks (see On Error Statement). If the intention is not to save New Workbooks, as implied by the error handler NotSavedYet, then validate the Path of the ActiveWorkbook, it will be empty if the workbook has not has been saved before.
The FileFinancialYear and MonthNumber variables never get populated.
Suggest to use specific workbook properties for Path and Name instead of FullName (see Workbook Object (Excel))
About the piece referred as Determine Base File Name
a. Programming: There is no need for IF statement, just use the Split function and take the item 0. The Split function returns ”a single-element array containing the entireexpression” when the delimiter is not present in the expression” (i.e. VersionExt and myFileName respectively).
b. Practicality: This piece seems to be redundant, as it’s meant to extract from variable myFileName the filename excluding the version and extension, however there is no such information in the variable as it has been populate just few lines above as:
myFileName = "Financial Report " & FileFinancialYear & " as at month " & MonthNumber
Therefore SaveName is always equal to myFileName
The first version of the file is indexed as 0 instead of 1.
The new indexed version will not always be the last index number + 1. If any of the previous versions is deleted or moved out to another folder as this version is missing the code will assign the missing version index to the latest file saved (see Fig. 1, note that time of the version 3 is newer than versions 4 & 5). Correction of this point requires a more complex approach as such it is not included in the revised code below.
Requirements: Based on the above a revised code is written that complies with the following requirements:
The procedure resides in a standalone workbook.
Files are always saved as xlOpenXMLWorkbookMacroEnabled (Extension xlsm)
New workbooks will not be saved as new versions.
Variables FileFinancialYear and MonthNumber are hardcoded as there is no indication of how they get populated (change as required).
The first time a file is saved and it does not exist in the source folder the file will be saved without version number.
The index of the first version should be 1 (change to 0 if required).
Option Explicit
Sub Wbk_SaveNewVersion_Xlsm()
Const kExt As String = ".xlsm"
Const kVrs As String = "_v"
Dim WbkAct As Workbook
Dim iYear As Integer, bMnth As Byte, sWbkStd As String
Dim sWbkPthNme As String, bVrs As Byte
Rem Set Standard Workbook Name
iYear = 2015 'Update Financial Year as required
bMnth = 9 'Update Month as required
sWbkStd = "Financial Report " & iYear & " as at month " & Format(bMnth, "00")
Rem Validate Active Workbook
Set WbkAct = ActiveWorkbook
If WbkAct.Name = ThisWorkbook.Name Then GoTo HdeThs
If WbkAct.Path = Empty Then GoTo NewWbk
Rem Get Workbook Properties
sWbkPthNme = WbkAct.Path & "\" & sWbkStd
Rem Validate Base File Existance
If Not (Fil_FileExist(sWbkPthNme & kExt)) Then
WbkAct.SaveAs sWbkPthNme & kExt, xlOpenXMLWorkbookMacroEnabled
MsgBox "A new workbook has been created: " & _
vbLf & vbLf & Chr(34) & sWbkStd & kExt & Chr(34), _
vbApplicationModal + vbInformation, "Workbook - Save a New Version - Xlsm"
Exit Sub
End If
Rem Save a New Version
bVrs = 1
sWbkPthNme = sWbkPthNme & kVrs
Do
If Fil_FileExist(sWbkPthNme & bVrs & kExt) Then
bVrs = 1 + bVrs
Else
WbkAct.SaveAs sWbkPthNme & bVrs & kExt, xlOpenXMLWorkbookMacroEnabled
Exit Do
End If
Loop
MsgBox "Version """ & bVrs & """ of workbook: " & _
vbLf & vbLf & Chr(34) & sWbkStd & Chr(34) & " has been created.", _
vbApplicationModal + vbInformation, "Workbook - Save a New Version - Xlsm"
HdeThs:
Call Wbk_Hide(ThisWorkbook)
Exit Sub
NewWbk:
MsgBox "Active Workbook """ & WbkAct.Name & """ has not been saved as yet." & vbLf & _
"A new version cannot be saved!", _
vbApplicationModal + vbCritical, "Workbook - Save New Version - Xlsm"
End Sub
Private Function Fil_FileExist(sFullName As String) As Boolean
Dim sDir As String
Fil_FileExist = (Dir(sFullName) <> Empty)
End Function
Private Sub Wbk_Hide(Wbk As Workbook)
Dim Wnd As Window
For Each Wnd In Wbk.Windows
Wnd.Visible = False
Next
End Sub

Writing text from Excel 2007 to a .txt file on a Sharepoint Site causes Run-Time error'76' Path not found

I have this VBA sub in an Excel 2007 project. It records user name, report name, date, and version on a .txt file in a Sharepoint site. Some of my users are getting a Run-Time error'76' Path not found issue.
Here's my code:
Sub logReport(ReportName As String)
Call AppendTxt("//myaviall/teamsites/AviallReportingSolutions/Airplane_Usage_Log/Airplane_ACT.txt", UNameWindows & ";" & ReportName & ";" & Now & ";" & VersionNum)
Dim oFS, TS, FileObj
'Get text stream
'Set oFS = CreateObject("Scripting.FileSystemObject")
'Set FileObj = oFS.GetFile("//myaviall/teamsites/AviallReportingSolutions/Airplane_Usage_Log/Airplane_ACT.txt")
'Set TS = FileObj.OpenAsTextStream(8, -2) 'ForWriting, TristateUseDefault)
' Write to file
'TS.WriteLine UNameWindows & ";" & ReportName & ";" & Now & ";" & VersionNum
'TS.Close
'Set TS = Nothing
'Set FileObj = Nothing
'Set oFS = Nothing
End Sub
Function AppendTxt(sFile As String, sText As String)
On Error GoTo Err_Handler
Dim FileNumber As Integer
FileNumber = FreeFile ' Get unused file number
Open sFile For Append As #FileNumber ' Connect to the file
Print #FileNumber, sText ' Append our string
Close #FileNumber ' Close the file
Exit_Err_Handler:
Exit Function
Err_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: AppendTxt" & vbCrLf & _
"Error Description: " & Err.Description, vbCritical, "An Error has Occured!"
GoTo Exit_Err_Handler
End Function
If there is only one user that is getting the issue the first thing that I would look at it access, as Scott points out.
I run a very similar procedure which writes a line to a csv file from outlook based on the code here
http://www.devhut.net/2011/06/06/vba-append-text-to-a-text-file/
This is probably not your answer but if the access is ok then it couldnt hurt to try another method.
Update
I also include this into my code to test if the file exists
exists = Dir$(sFile) <> fileName
Where fileName = "Airplane_ACT.txt" But I would maybe try this with a msgBox to see what it returns.
Also try try changing your string to Airplane_ACT_test.txt and run the code, this should create a new txt file, if this is the case then the issue may be related to your initial txt file.
Last thing: try with a different path eg: to the user's desktop.

Resources