Getting a filename Into a cell content

[rafi_07max]

In my workbook there is a button which I have assigned to save “board” sheet into a .txt file
I have no problem in saving the sheet into a txt file.

But what I want to do now is when I’m saving I will give the sheet a filename, for e.g. “ICT.txt” and I want this filename to appear in the column A of sheet 2, starting from cell A15.
Take a look at the image below:
http://yfrog.com/64savehj

So if cell A15 of sheet 2 has any content, the filename should be placed in A16
And when A16 has any content, then the filename should appear in cell a17…and so on.

I have attached a sample workbook with my codes.
Attachment 4972

[Bob Phillips]

Use

=MID(CELL("filename",A1),FIND("[",CELL("filename",A1))+1,FIND("]",CELL("filename",A1))-FIND("[",CELL("filename",A1))-1)

to get the filename

[rafi_07max]

Thanks Xld for your help but the formula didn't do what i intended. It just showed my current workbook name but what i wanted to do is whenever i click the save button the filename should continuously placed in column A

[Bob Phillips]

Isn't the workbook name the saved file name?

[p45cal]

You could use the before_save event to interrupt saving and ask a question or two. This snippet in the Thisworkbook code module should get you started:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Static Busy As Boolean
If Busy Then Exit Sub
ans = MsgBox("If you are about to save this as a text file and want the filename added to column A then click yes else click no", vbYesNo)
If ans = vbYes Then
    Cancel = True
  Set xxx = ThisWorkbook
  fname = Application.GetSaveAsFilename(fileFilter:="Text Files (*.txt), *.txt")
  If fname <> False Then
    AColumnText = Application.InputBox("Is this what you want to appear in column A?" & vbLf & vbLf & "If not, edit it now.", "Column A Text", Mid(fname, InStrRev(fname, Application.PathSeparator) + 1), , , , , 2)
    If AColumnText <> False Then
        With ActiveSheet
            For i = 15 To .Rows.Count
                If Cells(i, 1) = Empty Then
                    Cells(i, 1).Value = AColumnText
                    Exit For
                End If
            Next i
            Busy = True
           .SaveAs Filename:=fname, FileFormat:=xlTextWindows  ' I've only guessed at the fileformat.
           Busy = False
        End With
        Stop
    Else
        '      Stop
        Exit Sub
    End If  'AColumnText <> False
  Else
    Exit Sub
  End If  'fname <> False
Else
  Stop
  'should save as normal here
End If  'ans = vbYes
End Sub

It only places one instance of your chosen text in column A in the first available slot below A14 (ie starting from A15) since you're not clear on whether you want the whole column filled with that text or not. Also see a comment or two in the snippet.
It leaves you with the file open as a .txt file but your save existing save routine may need to be used.

[rafi_07max]

Xld, yes your codes did showed the name of my current workbook name, but that’s not what I want. I have a custom make save button in my sheet1 so whenever I click my custom make save button, then whatever filename I give to the file should start appearing on my sheet 2 cell A15 onwards
Take a look at my workbook and the image I attached

P45cal,, thanks for your help., your codes did worked for the excel save as button, but when I tried to combine your codes in my codes in my custom make ‘save as’ button, it didn’t work. Can you take a look at my attached workbook and see is it possible to combine the codes in my button with your codes. Thanks

[Kenneth Hobs]

I don't know what onwards means. I guess you might mean after multiple saves? If so, then maybe sheet2!A14 <> ""?

For the one entry, see the <--- line. If something like that above, then you would need to use Offset.

Private Sub CommandButton1_Click()
On Error GoTo saveErr
    Dim ws As Worksheet
    Set ws = Worksheets("Board")
    ws.Copy
    fileSaveName = Application.GetSaveAsFilename( _
                   fileFilter:="txt Files (*.txt), *.txt")
    If fileSaveName <> "False" Then
        ActiveWorkbook.SaveAs fileSaveName
ThisWorkbook.Worksheets("Sheet2").Range("A15").Value = fileSaveName '<----------------
ActiveWorkbook.Close
Else
        With Application
    .DisplayAlerts = 0
    .ScreenUpdating = 0
End With
    ActiveWorkbook.Close
    With Application
    .DisplayAlerts = 1
    .ScreenUpdating = 1
End With
    End If
    Exit Sub
saveErr:
    MsgBox "there is no board sheet to save", vbCritical, "ERROR"
End Sub

[rafi_07max]

Thanks Kenneth Hobs..it is almost working as i wanted but i only want to copy the filename into the cell. not the full destination. For e.g. if i save the file as "ICT", i only want the the word "ICT" on the cell A15 and not "C:\Documents and Settings\Desktop\ICT.txt".

Another thing is that i don't to overwrite the contetnt in cell A15. For e.g. if cell A15 of sheet 2 has any content, the filename should be placed in A16
And when A16 has any content, then the filename should appear in cell a17…and so on That's what i meant by 'onwards' in my previous reply.

[Kenneth Hobs]

You should backup any files selected because Kill was used to delete the file.

Private Sub CommandButton1_Click()
  'On Error GoTo saveErr
  Dim ws As Worksheet, fileSaveName, r As Range
  Set ws = Worksheets("Board")
  ws.Copy
  fileSaveName = Application.GetSaveAsFilename( _
                 fileFilter:="txt Files (*.txt), *.txt")
  If fileSaveName <> False Then
    Kill fileSaveName
    ActiveWorkbook.SaveAs fileSaveName
    ActiveWorkbook.Close
    Set r = Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    If r.Row < 15 Then Set r = Worksheets("Sheet2").Range("A15")
    r.Value = GetBaseName(CStr(fileSaveName))
  Else
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        ActiveWorkbook.Close
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    End If
  Exit Sub
saveErr:
  MsgBox "there is no board sheet to save", vbCritical, "ERROR"
End Sub

Function GetBaseName(filespec As String)
  Dim fso As Object
  Set fso = CreateObject("Scripting.FileSystemObject")
  GetBaseName = fso.GetBaseName(filespec)
End Function

[rafi_07max]

Thanks Kenneth Hobs for your help. It worked