If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below.

 
Go Back  dBforums > PC based Database Applications > Microsoft Access > doesn't want to show Save as dialog box when using Access VBA to save Excel change.

Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1 (permalink)  
Old 11-16-10, 08:55
newguyinaccess newguyinaccess is offline
Registered User
 
Join Date: Aug 2007
Posts: 88
doesn't want to show Save as dialog box when using Access VBA to save Excel change.

Hi Gurus,

One very nice guy in the forum provided the following function for me to delete a column in Excel and save the change.

Public Sub DeleteColumn( _
ByVal bookname As String, _
ByVal sheetname As String, _
ByVal cellcolumn As String)

Const xlShiftToLeft = -4159

Dim oXL As Object
Dim oBook As Object
Dim oSheet As Object

Set oXL = CreateObject("Excel.Application")
Set oBook = oXL.Workbooks.Open(bookname)
Set oSheet = oBook.Worksheets(sheetname)
oXL.Visible = False '''

oXL.DisplayAlerts = False ''''
oSheet.Range(cellcolumn).EntireColumn.Delete xlShiftToLeft

Set oSheet = Nothing

'oXL.ActiveWorkbook.Save
'oXL.ActiveWorkbook.SaveAs filename:=bookname
'oBook.Close SaveChanges:=True
oXL.ActiveWorkbook.SaveAs bookname



oBook.Close True
Set oBook = Nothing
oXL.DisplayAlerts = True '''
oXL.Quit
Set oXL = Nothing

End Sub

Another very nice guy also provided the following code to search a string in Excel and return the column number.

Public Function ColumnNo2(ByVal strText As String, ByVal FilePathName As String, ByVal ShtName As String) As Integer
Dim filename As String
Dim sht As Object
Dim objXL As Object
Dim ShtFound As Boolean

ShtFound = False
Const xlFormulas As Integer = -4123
Const xlPart As Integer = 2
Const xlByRows As Integer = 1
Const xlNext As Integer = 1

Set objXL = CreateObject("Excel.Application")

If Dir(FilePathName) <> "" Then
filename = Mid(FilePathName, InStrRev(FilePathName, "\") + 1)

With objXL
.Workbooks.Open FilePathName

For Each sht In .ActiveWorkbook.Sheets
If sht.Name = ShtName Then
ShtFound = True

On Error Resume Next
ColumnNo2 = sht.Cells.Find(What:=strText, After:=objXL.Cells(1, 1), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Column
On Error GoTo 0
If ColumnNo2 = 0 Then MsgBox "Text '" & strText & "' not found in file " & filename & " (" & ShtName & ")", vbExclamation, "Find Column"

End If
Next sht
If Not ShtFound Then MsgBox "Sheet '" & ShtName & "' could not be found in file '" & filename & "'!", vbExclamation, "Find Column"


.Workbooks(filename).Close False
End With
End If
End Function


When I use the following code to call the delete column function, it works perfectly without prompting the save as dialog box.

Private Sub cmd1_Click()
Dim bookname As String
bookname = "c:\file1.xls"

Dim sheetname As String
sheetname = "file1"

Dim cellcolumn As String

cellcolumn = "H:H"

Call DeleteColumn(bookname, sheetname, cellcolumn)


End Sub

' the following function converts the Excel column from number to letter

Public Function ColumnLetter(ByVal ColumnNumber As Integer) As String
If ColumnNumber > 26 Then

' 1st character: Subtract 1 to map the characters to 0-25,
' but you don't have to remap back to 1-26
' after the 'Int' operation since columns
' 1-26 have no prefix letter

' 2nd character: Subtract 1 to map the characters to 0-25,
' but then must remap back to 1-26 after
' the 'Mod' operation by adding 1 back in
' (included in the '65')

ColumnLetter = Chr(Int((ColumnNumber - 1) / 26) + 64) & _
Chr(((ColumnNumber - 1) Mod 26) + 65)
Else
' Columns A-Z
ColumnLetter = Chr(ColumnNumber + 64)
End If
End Function

However, when I use the following code, it always prompt save us dialog box to ask me if I want to replace the existing file and I have to click Yes to save the change. I am confused that why calling the same function, but one prompt the save as but the other doesn't prompt the save as dialog box.
Because of the way to pass the parameters???

Is there a way to eliminate the save us dialog box? Thank you very much!

.................................................. ......
Dim f1 As String

' strpath4 is a variable for a directory path

f1 = strpath4 & "\fOL.xls"

sht = "fOL"

dim skc1 as string
dim skc2 as variant ' getting skc2 from dlookup function from a column in a database table field which may return null or a integer. e.g. 8
dim colno1 as integer
dim colletter1, cl1 as string

If Not IsNothing(skc2) Then

skc1 = "C_" & CStr(skc2) 'for example skc1 = "C_" & CStr(8)

colno1 = ColumnNo2(skc1, strpath4 & "\fOL.xls", sht) 'for example colno1 = 8
colletter1 = ColumnLetter(colno1) 'for example colletter1=H
cl1 = colletter1 & ":" & colletter1



Call DeleteColumn(f1, sht, cl1)


End If
Reply With Quote
Reply

Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is Off
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On